Ask the object, not the text, whether the daemon built with -g
test_session.ml asserts that a debug session emits the metadata, which is the unpassed-argument defect itself. It cannot see the other half: it is Build.shared that turns the flag into -g and -O0 on the module, and a daemon that dropped Build.debug from its opts would still emit perfect IR and then compile it away — llvm.dbg.declare describes an alloca and mem2reg deletes the alloca, so the symptom would be a module that looks right in every text assertion and has no locals in the debugger. So this drives a real `flan dev --debug`, sends one redefinition, and runs llvm-dwarfdump over the .so the daemon actually wrote. The line table is the needle because it is what a breakpoint in a .flan buffer resolves against, and it names the file the form was typed in rather than anything on disk. Skipped where there is no llvm-dwarfdump.
This commit is contained in:
parent
d0a8339bb5
commit
4723e49e4d
@ -697,6 +697,87 @@ let () =
|
|||||||
end;
|
end;
|
||||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ];
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ];
|
||||||
|
|
||||||
|
(* --debug, and the half the IR cannot show.
|
||||||
|
|
||||||
|
[test_session.ml] asserts that a debug session *emits* the metadata,
|
||||||
|
which is the unpassed-argument defect itself. It cannot see the other
|
||||||
|
half: [Build.shared] is what turns the flag into [-g] and [-O0] on the
|
||||||
|
module, and a daemon that dropped [Build.debug] from its opts would
|
||||||
|
still emit perfect IR and then compile it away — [llvm.dbg.declare]
|
||||||
|
describes an alloca and mem2reg deletes the alloca. So this goes to the
|
||||||
|
.so the daemon actually wrote and asks the object, not the text.
|
||||||
|
|
||||||
|
The line table is the needle because it is what a breakpoint in a .flan
|
||||||
|
buffer resolves against, and it names the file the form was typed in
|
||||||
|
rather than any file on disk. *)
|
||||||
|
if Sys.command "command -v llvm-dwarfdump > /dev/null 2>&1" = 0 then begin
|
||||||
|
let gsock = tmp "dbg.sock" and gout = tmp "dbg.out" in
|
||||||
|
(try Sys.remove gsock with Sys_error _ -> ());
|
||||||
|
let gfd =
|
||||||
|
Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||||
|
in
|
||||||
|
let gpid =
|
||||||
|
Unix.create_process flan
|
||||||
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; gsock; "--debug" |]
|
||||||
|
Unix.stdin gfd Unix.stderr
|
||||||
|
in
|
||||||
|
Unix.close gfd;
|
||||||
|
if not (await (fun () -> Sys.file_exists gsock)) then begin
|
||||||
|
fail "the --debug daemon never listened";
|
||||||
|
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
let c = connect gsock in
|
||||||
|
let r =
|
||||||
|
request c
|
||||||
|
"(:op \"eval\" :code \"(defn step [] i64 (let [n (i64 3)] (set ticks (+ ticks n)) ticks))\" :file \"/tmp/dbg.flan\")"
|
||||||
|
in
|
||||||
|
if status r <> "ok" then
|
||||||
|
fail "a --debug daemon refused an ordinary redefinition: %s"
|
||||||
|
(Option.value ~default:"" (Wire.string_field r "message"))
|
||||||
|
else begin
|
||||||
|
(* The daemon builds into /tmp/flan-dev-<pid>, one module per eval,
|
||||||
|
and never reuses a name — dlopen caches by path. The first is
|
||||||
|
m1.so. *)
|
||||||
|
let so =
|
||||||
|
Filename.concat
|
||||||
|
(Filename.concat (Filename.get_temp_dir_name ())
|
||||||
|
(Printf.sprintf "flan-dev-%d" gpid))
|
||||||
|
"m1.so"
|
||||||
|
in
|
||||||
|
if not (Sys.file_exists so) then
|
||||||
|
fail "the --debug daemon left no module at %s" so
|
||||||
|
else begin
|
||||||
|
let dump = tmp "dbg.dwarf" in
|
||||||
|
let code =
|
||||||
|
Sys.command
|
||||||
|
(Printf.sprintf "llvm-dwarfdump --debug-line %s > %s 2>&1"
|
||||||
|
(Filename.quote so) (Filename.quote dump))
|
||||||
|
in
|
||||||
|
let text =
|
||||||
|
if code <> 0 then ""
|
||||||
|
else In_channel.with_open_bin dump In_channel.input_all
|
||||||
|
in
|
||||||
|
(try Sys.remove dump with Sys_error _ -> ());
|
||||||
|
let has hay needle =
|
||||||
|
let n = String.length needle and h = String.length hay in
|
||||||
|
let rec go i =
|
||||||
|
i + n <= h && (String.sub hay i n = needle || go (i + 1))
|
||||||
|
in
|
||||||
|
n > 0 && go 0
|
||||||
|
in
|
||||||
|
if not (has text "dbg.flan") then
|
||||||
|
fail
|
||||||
|
"a --debug daemon's module carries no line table for the form's \
|
||||||
|
file, so a line breakpoint would stay pending across C-c C-c"
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ());
|
||||||
|
(try ignore (Unix.waitpid [] gpid) with Unix.Unix_error _ -> ())
|
||||||
|
end;
|
||||||
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ]
|
||||||
|
end;
|
||||||
|
|
||||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||||
[ sock; out; bsock; bout ];
|
[ sock; out; bsock; bout ];
|
||||||
if !failures = 0 then print_endline "dev: all tests passed"
|
if !failures = 0 then print_endline "dev: all tests passed"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user