Check the offsets against LLVM, not against the same hand that wrote them
A wrong DWARF member offset does not crash anything. It prints a plausible value for the wrong field, which is the failure this project has met over and over at the FFI boundary, and it is the only way the debug info can be wrong without saying so. A table of expected offsets written in this test would be wrong in exactly the ways the code is wrong, so it checks against LLVM instead: ptrtoint of a getelementptr through a null pointer, over the struct type text lifted out of the emitted module, folded by llc into a .quad and read back. That is the same idiom Emit already uses for the size it hands flan_dev_global — it is just not expressible inside metadata, where offset: must be an integer literal. Then the same struct again with its fields permuted, and an assertion that the two disagree. A check that cannot come out differently is not checking anything: an offset table that ignored declaration order would satisfy either ordering alone. It fails when it should. Making a slice 4-byte aligned moves Cell.name from 24 to 20; the test says so by name, and lldb — which is the point — prints len = 21474836480 for a five-character string. The lldb cases are the only ones that say a person can debug a Flan program rather than that the metadata is self-consistent: a breakpoint on a Flan function by name, a backtrace naming .flan files and lines, and locals with their own types and values. Skipped where there is no lldb, since it is not a build dependency. The --dev case is there because "the stack goes missing under --dev" is the sort of thing found late. It does not: a cell changes how the callee is found, not how the frame is laid out.
This commit is contained in:
parent
ba2f5bc9bb
commit
67aa82457d
25
test/programs/debug-permuted.flan
Normal file
25
test/programs/debug-permuted.flan
Normal file
@ -0,0 +1,25 @@
|
||||
;;;; debug.flan with the fields of Cell in a different order and nothing else
|
||||
;;;; changed. The program prints the same four lines; the struct is a different
|
||||
;;;; shape, and every member sits at a different offset.
|
||||
;;;;
|
||||
;;;; name at 0 (16), id at 16, alive at 20, 3 of padding, heat at 24 — so a
|
||||
;;;; DWARF offset table that is right for debug.flan is wrong for all four
|
||||
;;;; members here, which is what makes the pair a test rather than an
|
||||
;;;; observation.
|
||||
|
||||
(defstruct Cell [name string id i32 alive bool heat f64])
|
||||
|
||||
(defn tick [c (Ptr Cell) n i32] i32
|
||||
(let [bump (+ n 1)]
|
||||
(set (.heat c) (+ (.heat c) 1.5))
|
||||
(set (.id c) bump)
|
||||
bump))
|
||||
|
||||
(defn main [] i32
|
||||
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
|
||||
(let [r (tick (addr c) 41)]
|
||||
(print-i64 (i64 r)) (newline)
|
||||
(print-f64 (.heat c)) (newline)
|
||||
(print-i64 (i64 (.id c))) (newline)
|
||||
(print-str (.name c)) (newline)
|
||||
0)))
|
||||
30
test/programs/debug.flan
Normal file
30
test/programs/debug.flan
Normal file
@ -0,0 +1,30 @@
|
||||
;;;; The program the source-level debugging case runs under lldb.
|
||||
;;;;
|
||||
;;;; Every field holds a distinct known value of a distinct shape, so a DWARF
|
||||
;;;; member offset that is wrong prints something obviously wrong rather than
|
||||
;;;; something plausible — which is the failure mode this whole case exists
|
||||
;;;; for. debug-permuted.flan is the same program with the fields declared in
|
||||
;;;; a different order and every value unchanged: the two must print the same
|
||||
;;;; field/value pairs from different offsets.
|
||||
;;;;
|
||||
;;;; alive at 0 (a byte), 7 of padding, heat at 8, id at 16, 4 of padding,
|
||||
;;;; name at 24 — the slice is the member that moves if the alignment rule is
|
||||
;;;; wrong, because it is the only one whose own alignment exceeds its first
|
||||
;;;; member's size.
|
||||
|
||||
(defstruct Cell [alive bool heat f64 id i32 name string])
|
||||
|
||||
(defn tick [c (Ptr Cell) n i32] i32
|
||||
(let [bump (+ n 1)]
|
||||
(set (.heat c) (+ (.heat c) 1.5))
|
||||
(set (.id c) bump)
|
||||
bump))
|
||||
|
||||
(defn main [] i32
|
||||
(let [c (Cell {:alive true :heat 3.25 :id 7 :name "grain"})]
|
||||
(let [r (tick (addr c) 41)]
|
||||
(print-i64 (i64 r)) (newline)
|
||||
(print-f64 (.heat c)) (newline)
|
||||
(print-i64 (i64 (.id c))) (newline)
|
||||
(print-str (.name c)) (newline)
|
||||
0)))
|
||||
@ -859,6 +859,436 @@ ERR@7 unexpected token: not the kind the caller was reading
|
||||
"(declare-c a [] \"Same\")\n(declare-c b [] \"Same\")"
|
||||
"one declare-c per C function";
|
||||
|
||||
(* -- Source-level debugging: DWARF, and whether it is true ---------
|
||||
The whole of this section is about one risk. A Flan struct is its C
|
||||
struct and lldb needs to learn nothing about the data model, which is
|
||||
what makes DWARF cheap here; but !DIDerivedType takes its member offset
|
||||
as an integer literal, so those offsets are the one layout number the
|
||||
backend works out for itself instead of handing to LLVM. A wrong one
|
||||
does not crash: it prints a plausible value for the wrong field, which
|
||||
is the failure this project has met over and over at the FFI boundary.
|
||||
|
||||
So the offsets are not checked against a table written by the same hand
|
||||
as the code. They are checked against LLVM's own answer for the same
|
||||
struct type — ptrtoint of a getelementptr through a null pointer, which
|
||||
is exactly the idiom Emit already uses for the size it passes to
|
||||
flan_dev_global — constant-folded by llc into a .quad and read back.
|
||||
And the whole thing is run twice over the same struct with its fields
|
||||
permuted, because a check that cannot come out differently is not
|
||||
checking anything. *)
|
||||
|
||||
(* Small text tools, since there is no Str and the reader is hand-written
|
||||
for the same reason. *)
|
||||
let lines_of s = String.split_on_char '\n' s in
|
||||
let index_of hay needle =
|
||||
let n = String.length needle and h = String.length hay in
|
||||
let rec go i =
|
||||
if i + n > h then -1 else if String.sub hay i n = needle then i else go (i + 1)
|
||||
in
|
||||
go 0
|
||||
in
|
||||
(* The value of [key: ] in a metadata node, up to the next , or ). *)
|
||||
let attr line key =
|
||||
let k = key ^ ": " in
|
||||
match index_of line k with
|
||||
| -1 -> None
|
||||
| i ->
|
||||
let i = i + String.length k in
|
||||
let j = ref i in
|
||||
let n = String.length line in
|
||||
while !j < n && line.[!j] <> ',' && line.[!j] <> ')' do incr j done;
|
||||
Some (String.sub line i (!j - i))
|
||||
in
|
||||
(* [elements: !{!12, !13}] — the value has commas in it, so it needs its
|
||||
own reader rather than [attr]'s stop-at-the-next-comma. *)
|
||||
let attr_ids line key =
|
||||
let k = key ^ ": !{" in
|
||||
match index_of line k with
|
||||
| -1 -> []
|
||||
| i ->
|
||||
let i = i + String.length k in
|
||||
let j = ref i and n = String.length line in
|
||||
while !j < n && line.[!j] <> '}' do incr j done;
|
||||
String.sub line i (!j - i)
|
||||
|> String.split_on_char ','
|
||||
|> List.filter_map (fun t ->
|
||||
let t = String.trim t in
|
||||
if String.length t > 1 && t.[0] = '!' then
|
||||
int_of_string_opt (String.sub t 1 (String.length t - 1))
|
||||
else None)
|
||||
in
|
||||
let unquote s =
|
||||
let n = String.length s in
|
||||
if n >= 2 && s.[0] = '"' && s.[n - 1] = '"' then String.sub s 1 (n - 2) else s
|
||||
in
|
||||
(* The parameter names come down from the driver, exactly as [bin/main.ml]
|
||||
sends them: the typed IR does not carry them. *)
|
||||
let pnames_of decls =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defn fn ->
|
||||
Some (fn.Ast.name,
|
||||
List.map (fun (f : Ast.field) -> f.Ast.fname) fn.Ast.params)
|
||||
| _ -> None)
|
||||
decls
|
||||
in
|
||||
let debug_ir src =
|
||||
let decls = Parse.program (Reader.read_all ~file:"<dwarf-test>" src) in
|
||||
Emit.program ~debug:true ~pnames:(pnames_of decls) (Check.program decls)
|
||||
in
|
||||
(* Every (member name, byte offset) of a named struct, in declaration
|
||||
order, as the emitted DWARF states it. *)
|
||||
let dwarf_members ir sname =
|
||||
let ls = lines_of ir in
|
||||
let node id =
|
||||
List.find_opt
|
||||
(fun l -> String.starts_with ~prefix:(Printf.sprintf "!%d = " id) l) ls
|
||||
in
|
||||
let composite =
|
||||
List.find_opt
|
||||
(fun l ->
|
||||
index_of l "!DICompositeType(tag: DW_TAG_structure_type" >= 0
|
||||
&& attr l "name" = Some (Printf.sprintf "\"%s\"" sname))
|
||||
ls
|
||||
in
|
||||
match composite with
|
||||
| None -> None
|
||||
| Some c ->
|
||||
let ids = attr_ids c "elements" in
|
||||
Some
|
||||
((List.filter_map
|
||||
(fun id ->
|
||||
match node id with
|
||||
| None -> None
|
||||
| Some l ->
|
||||
(match attr l "name", attr l "offset" with
|
||||
| Some n, Some o ->
|
||||
Some (unquote n, int_of_string (String.trim o) / 8)
|
||||
| _ -> None))
|
||||
ids),
|
||||
(match attr c "size" with
|
||||
| Some sz -> int_of_string (String.trim sz) / 8
|
||||
| None -> -1))
|
||||
in
|
||||
(* LLVM's own answer, for the same struct type text the DWARF describes.
|
||||
The type definitions are lifted straight out of the emitted module, so
|
||||
there is no second spelling of the layout to get wrong. *)
|
||||
let llvm_members ir sname nfields =
|
||||
let tydefs =
|
||||
lines_of ir
|
||||
|> List.filter (fun l ->
|
||||
String.length l > 0 && l.[0] = '%' && index_of l " = type " >= 0)
|
||||
in
|
||||
let sty = Printf.sprintf "%%\"%s\"" sname in
|
||||
let b = Buffer.create 512 in
|
||||
List.iter (fun l -> Buffer.add_string b (l ^ "\n")) tydefs;
|
||||
for i = 0 to nfields - 1 do
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"@o%d = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 0, i32 %d) to i64)\n"
|
||||
i sty i)
|
||||
done;
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"@sz = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64)\n"
|
||||
sty);
|
||||
let ll = Filename.concat scratch "flan-dwarf-oracle.ll" in
|
||||
let asm = Filename.concat scratch "flan-dwarf-oracle.s" in
|
||||
Out_channel.with_open_bin ll (fun ch -> Out_channel.output_string ch (Buffer.contents b));
|
||||
let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc" in
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf "%s -filetype=asm %s -o %s > /dev/null 2>&1"
|
||||
(Filename.quote llc) (Filename.quote ll) (Filename.quote asm))
|
||||
in
|
||||
if code <> 0 then None
|
||||
else begin
|
||||
let text = In_channel.with_open_bin asm In_channel.input_all in
|
||||
(try Sys.remove ll with Sys_error _ -> ());
|
||||
(try Sys.remove asm with Sys_error _ -> ());
|
||||
(* llc writes the folded constant as ".quad 0+24" — a sum, because the
|
||||
null base is still a symbolic zero to the assembler. *)
|
||||
let pending = ref "" and acc = ref [] in
|
||||
List.iter
|
||||
(fun l ->
|
||||
let t = String.trim l in
|
||||
if String.length t > 1 && t.[String.length t - 1] = ':' then
|
||||
pending := String.sub t 0 (String.length t - 1)
|
||||
else if index_of t ".quad" >= 0 && !pending <> "" then begin
|
||||
let v = String.trim (String.sub t 5 (String.length t - 5)) in
|
||||
let v = match index_of v "#" with -1 -> v | i -> String.sub v 0 i in
|
||||
let n =
|
||||
String.split_on_char '+' v
|
||||
|> List.fold_left
|
||||
(fun a part ->
|
||||
match int_of_string_opt (String.trim part) with
|
||||
| Some x -> a + x
|
||||
| None -> a)
|
||||
0
|
||||
in
|
||||
acc := (!pending, n) :: !acc;
|
||||
pending := ""
|
||||
end)
|
||||
(lines_of text);
|
||||
Some (List.rev !acc)
|
||||
end
|
||||
in
|
||||
(* The case itself: the DWARF a source text produces must agree with LLVM
|
||||
on every member's offset, and on the struct's size. *)
|
||||
let layout_case name src sname fields =
|
||||
let ir = debug_ir src in
|
||||
match dwarf_members ir sname with
|
||||
| None ->
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n no DWARF type for %s\n" name sname
|
||||
| Some (members, size) ->
|
||||
let got = List.map fst members in
|
||||
if got <> fields then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n DWARF members: %s\n wanted: %s\n"
|
||||
name (String.concat " " got) (String.concat " " fields)
|
||||
end;
|
||||
(match llvm_members ir sname (List.length fields) with
|
||||
| None ->
|
||||
(* No llc is a reason to skip the oracle, not to pass silently. *)
|
||||
Printf.printf "acceptance: %s — llc unavailable, offsets unchecked\n" name
|
||||
| Some oracle ->
|
||||
List.iteri
|
||||
(fun i (fname, off) ->
|
||||
match List.assoc_opt (Printf.sprintf "o%d" i) oracle with
|
||||
| None -> ()
|
||||
| Some want ->
|
||||
if off <> want then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s\n %s.%s at byte %d in the DWARF, %d in LLVM\n"
|
||||
name sname fname off want
|
||||
end)
|
||||
members;
|
||||
(match List.assoc_opt "sz" oracle with
|
||||
| Some want when want <> size ->
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s\n %s is %d bytes in the DWARF, %d in LLVM\n"
|
||||
name sname size want
|
||||
| _ -> ()));
|
||||
()
|
||||
in
|
||||
let cell = "(defstruct Cell [alive bool heat f64 id i32 name string])\n" in
|
||||
let cell' = "(defstruct Cell [name string id i32 alive bool heat f64])\n" in
|
||||
let body = "(defn main [] i32 (let [c (Cell {:id 1})] (i32 (.id c))))\n" in
|
||||
layout_case "DWARF offsets agree with LLVM: a mixed struct" (cell ^ body)
|
||||
"Cell" [ "alive"; "heat"; "id"; "name" ];
|
||||
(* The same struct, permuted. If the offsets came from anywhere but the
|
||||
declaration order they would survive this, and they do not. *)
|
||||
layout_case "DWARF offsets agree with LLVM: the same fields permuted"
|
||||
(cell' ^ body) "Cell" [ "name"; "id"; "alive"; "heat" ];
|
||||
layout_case "DWARF offsets agree with LLVM: nesting and fixed arrays"
|
||||
("(defstruct P [x i32 y i32])\n\
|
||||
(defstruct Board [tag u8 cells [4 P] here P edge (Ptr P) seen (Option i64)])\n\
|
||||
(defn main [] i32 (let [b (Board {:tag 1})] (i32 (.tag b))))\n")
|
||||
"Board" [ "tag"; "cells"; "here"; "edge"; "seen" ];
|
||||
|
||||
(* Permuting the fields must actually move them. Asserting that the two
|
||||
orderings disagree is what makes the two cases above a test: an offset
|
||||
table that ignored declaration order would satisfy both. *)
|
||||
(match dwarf_members (debug_ir (cell ^ body)) "Cell",
|
||||
dwarf_members (debug_ir (cell' ^ body)) "Cell" with
|
||||
| Some (a, _), Some (b, _) ->
|
||||
let off l n = List.assoc_opt n l in
|
||||
if List.for_all (fun n -> off a n = off b n) [ "alive"; "heat"; "id"; "name" ]
|
||||
then begin
|
||||
incr failures;
|
||||
print_endline
|
||||
"FAIL permuting a defstruct left every DWARF offset unchanged"
|
||||
end
|
||||
| _ ->
|
||||
incr failures;
|
||||
print_endline "FAIL permuting a defstruct: no DWARF type for Cell");
|
||||
|
||||
(* A slot's *type* has to be right too, not only where it sits. These are
|
||||
the shapes lldb has to render, and the layout table says what each one
|
||||
weighs; a wrong size there is a truncated or over-read value. *)
|
||||
let ir = debug_ir (cell ^ body) in
|
||||
List.iter
|
||||
(fun (needle, what) ->
|
||||
if not (contains ir needle) then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL DWARF for %s\n wanted: %S\n" what needle
|
||||
end)
|
||||
[ ("!DIBasicType(name: \"i32\", size: 32, encoding: DW_ATE_signed)", "i32");
|
||||
("!DIBasicType(name: \"u8\", size: 8, encoding: DW_ATE_unsigned)", "u8");
|
||||
("!DIBasicType(name: \"f64\", size: 64, encoding: DW_ATE_float)", "f64");
|
||||
(* A byte in memory, not a bit: an i1 alloca is one byte wide. *)
|
||||
("!DIBasicType(name: \"bool\", size: 8, encoding: DW_ATE_boolean)", "bool");
|
||||
(* ptr+len, and shown as ptr+len — there is no owner and no capacity
|
||||
to hide, so two members are the whole truth about a string. *)
|
||||
("name: \"string\", size: 128", "string");
|
||||
(* A let-bound local has no name to keep: the typed IR refers to
|
||||
slots by index and [Check] drops what they were called, so it is
|
||||
emitted as the slot it is. Asserted rather than left implicit,
|
||||
because this is the one honest gap in the picture. *)
|
||||
("!DILocalVariable(name: \"s0\"", "a let-bound local, named by its slot");
|
||||
("!llvm.dbg.cu = ", "the compile unit is registered");
|
||||
(* Without this LLVM discards every node above, silently. *)
|
||||
("!{i32 2, !\"Debug Info Version\", i32 3}", "the module flag") ];
|
||||
|
||||
(* Parameters carry the name the source gave them. The typed IR does not
|
||||
record it — [Check] has it and drops it — so this is the driver handing
|
||||
the names down, and it is worth a test because the path is easy to
|
||||
forget when either end changes. *)
|
||||
let ir =
|
||||
debug_ir "(defn dist [ax f64 ay f64] f64 (+ ax ay))\n\
|
||||
(defn main [] i32 (i32 (i64 (dist 1.0 2.0))))\n"
|
||||
in
|
||||
List.iter
|
||||
(fun needle ->
|
||||
if not (contains ir needle) then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL parameter names in DWARF\n wanted: %S\n" needle
|
||||
end)
|
||||
[ "!DILocalVariable(name: \"ax\", arg: 1"; "!DILocalVariable(name: \"ay\", arg: 2" ];
|
||||
(* The transfer channel is a parameter of every Flan function and is not a
|
||||
Flan name, so it gets no variable at all — and must not, or it would
|
||||
take arg: 1 and shift every real parameter's storage by one. *)
|
||||
if contains ir "name: \"xfer\"" then begin
|
||||
incr failures;
|
||||
print_endline "FAIL the transfer channel appeared as a local variable"
|
||||
end;
|
||||
|
||||
(* A debug build and a release build must still be the same program. *)
|
||||
let debug_compile ?(dev = false) path =
|
||||
let exe =
|
||||
Filename.concat scratch
|
||||
("flan-dbg-" ^ Filename.remove_extension (Filename.basename path)
|
||||
^ if dev then "-dev" else "")
|
||||
in
|
||||
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
|
||||
let p = Check.program l.Load.decls in
|
||||
let pnames =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defn fn ->
|
||||
Some (fn.Ast.name,
|
||||
List.map (fun (f : Ast.field) -> f.Ast.fname) fn.Ast.params)
|
||||
| _ -> None)
|
||||
l.Load.decls
|
||||
in
|
||||
let p, csrcs, lflags = Reach.link ~dev l p in
|
||||
ignore
|
||||
(Build.executable ~opts:{ Build.default with debug = true; dev }
|
||||
~csrcs ~lflags ~pnames p ~out:exe);
|
||||
exe
|
||||
in
|
||||
let expected = "42\n4.75\n42\ngrain\n" in
|
||||
List.iter
|
||||
(fun path ->
|
||||
let exe = debug_compile path in
|
||||
let code, text = run exe None in
|
||||
if text <> expected || code <> 0 then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL a --debug build of %s runs the same\n got: %S (exit %d)\n wanted: %S\n"
|
||||
path text code expected
|
||||
end)
|
||||
[ "programs/debug.flan"; "programs/debug-permuted.flan" ];
|
||||
|
||||
(* wasm32 is refused by name. The offsets above are the host's, and
|
||||
wasm32's 32-bit pointer moves every slice member; emitting them anyway
|
||||
would give a debugger a confident wrong answer. *)
|
||||
(match
|
||||
Build.executable
|
||||
~opts:{ Build.default with debug = true; target = Some "wasm32-wasi" }
|
||||
{ Tast.structs = []; unions = []; globals = []; externs = []; fns = [];
|
||||
cshim = [] }
|
||||
~out:(Filename.concat scratch "flan-dbg-wasm")
|
||||
with
|
||||
| _ ->
|
||||
incr failures;
|
||||
print_endline "FAIL --debug --target=wasm32-wasi was accepted"
|
||||
| exception Failure m ->
|
||||
if not (contains m "--debug is native only") then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL --debug on wasm32\n said: %S\n" m
|
||||
end);
|
||||
|
||||
(* -- lldb, for real ------------------------------------------------
|
||||
Everything above is about the metadata being self-consistent. This is
|
||||
the only part that says a person can debug a Flan program: a breakpoint
|
||||
set on a Flan function *by name*, a backtrace with .flan files and line
|
||||
numbers, and locals printed with their own types and values. It is
|
||||
skipped rather than failed where there is no lldb. *)
|
||||
if Sys.command "command -v lldb > /dev/null 2>&1" = 0 then begin
|
||||
let lldb_run exe cmds =
|
||||
let out = Filename.concat scratch "flan-lldb.out" in
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf "lldb -b %s %s > %s 2>&1"
|
||||
(String.concat " "
|
||||
(List.map (fun c -> "-o " ^ Filename.quote c) cmds))
|
||||
(Filename.quote exe) (Filename.quote out))
|
||||
in
|
||||
let text = In_channel.with_open_bin out In_channel.input_all in
|
||||
(try Sys.remove out with Sys_error _ -> ());
|
||||
(code, text)
|
||||
in
|
||||
let lldb_case name path needles =
|
||||
let exe = debug_compile path in
|
||||
let _, text =
|
||||
lldb_run exe
|
||||
[ "breakpoint set --name flan.tick"; "run"; "bt"; "frame variable";
|
||||
"p *c" ]
|
||||
in
|
||||
List.iter
|
||||
(fun n ->
|
||||
if not (contains text n) then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n wanted %S in lldb's output\n"
|
||||
name n;
|
||||
print_endline text
|
||||
end)
|
||||
needles
|
||||
in
|
||||
(* The four claims, one needle each: the breakpoint resolved on a Flan
|
||||
name; the frame names a .flan file and a line inside tick; the caller
|
||||
is the Flan main and not a C frame; a parameter prints by its source
|
||||
name; and the struct through the pointer prints every field with the
|
||||
value the program put there. *)
|
||||
lldb_case "lldb: breakpoint, frames and locals" "programs/debug.flan"
|
||||
[ "flan.tick"; "at debug.flan:"; "flan.main at debug.flan:";
|
||||
"(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5" ];
|
||||
(* And the same, with the fields permuted. If the offsets were not
|
||||
following the declaration, the values would land on the wrong names
|
||||
here and nowhere else. *)
|
||||
lldb_case "lldb: the same struct with its fields permuted"
|
||||
"programs/debug-permuted.flan"
|
||||
[ "at debug-permuted.flan:"; "flan.main at debug-permuted.flan:";
|
||||
"(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5" ];
|
||||
(* A dev build routes every call through a cell, so the call site is an
|
||||
indirect call through a mutable global. The frame above it is still
|
||||
the Flan caller with its own line: the indirection is in how the
|
||||
callee is found, not in how the frame is laid out, so nothing about
|
||||
unwinding changes. Worth pinning, because "the stack goes missing
|
||||
under --dev" would be the sort of thing found late. *)
|
||||
let exe = debug_compile ~dev:true "programs/debug.flan" in
|
||||
let _, text =
|
||||
lldb_run exe [ "breakpoint set --name flan.tick"; "run"; "bt" ]
|
||||
in
|
||||
List.iter
|
||||
(fun n ->
|
||||
if not (contains text n) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL lldb: --dev --debug keeps the Flan stack\n wanted %S\n"
|
||||
n;
|
||||
print_endline text
|
||||
end)
|
||||
[ "flan.tick"; "flan.main at debug.flan:" ]
|
||||
end
|
||||
else print_endline "acceptance: lldb cases skipped (no lldb on PATH)";
|
||||
|
||||
if !failures = 0 then print_endline "acceptance: all tests passed"
|
||||
else begin
|
||||
Printf.printf "\n%d failure(s)\n" !failures;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user