diff --git a/test/test_dev.ml b/test/test_dev.ml index 911e835..ea410bb 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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-, 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"