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;
|
||||
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 _ -> ())
|
||||
[ sock; out; bsock; bout ];
|
||||
if !failures = 0 then print_endline "dev: all tests passed"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user