From e6594fd554385fb174cb24b6a30a344f2be737bb Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 05:05:40 +0700 Subject: [PATCH 1/3] The name the source gave a local, all the way to the debugger MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A let-bound local printed as s0 under lldb. Parameters were fine, because the driver recovered their names from the AST and handed them down in pnames; everything else was a slot index, since Check knew the name in its scope list and dropped it at allocation. Tast.fn now carries snames beside slots, Check fills it in at bind, and Emit prefers it over pnames. A slot the compiler invented keeps s: fresh_slot takes the name as an optional argument, so dotimes' hidden bound and the pair min and max evaluate into say nothing and get None without any of their call sites changing. Naming those something plausible would put a variable in the debugger that is not in the file. Shadowing needed deciding rather than assuming. Every DILocalVariable is scoped to the subprogram — the typed IR has no block structure to build a DILexicalBlock from — so two slots called v landed in one flat scope, and lldb answered p v with the outer one while the body computed with the inner, which it did not list at all. A debugger confident and wrong is the one outcome worse than s0, so a repeat of a name already bound in this function gets a ~2 suffix: ~ is the reader's delimiter and cannot occur in a source symbol, so v~2 is unambiguous and visibly the compiler's. It is a way of not lying, not a way of being right; scoping properly means a lexical block per Let and the declares moved out of the entry block. (lldb) breakpoint set --file debug.flan --line 20 (lldb) frame variable (Cell *) c = 0x00007fffffffd970 (int) n = 41 (int) bump = 42 The test breaks after the binding on purpose. A name breakpoint stops on the function's first line, before the let has stored anything, and a variable is nominally in scope from entry — so the name is checked there and the value only where it means something. --- lib/check.ml | 64 ++++++++++++++++++++++++++++++------ lib/emit.ml | 41 ++++++++++++++--------- lib/session.ml | 7 ++-- lib/tast.ml | 9 ++++++ test/test_acceptance.ml | 72 +++++++++++++++++++++++++++++++++++++---- 5 files changed, 161 insertions(+), 32 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 59ba57f..a13ceb0 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -83,6 +83,11 @@ type ctx = { (* The type of each slot, newest first. A backend needs it to size the frame — nothing else records it, since the IR refers to slots by index. *) mutable slot_tys : Types.t list; + (* The source name of each slot, newest first, parallel to [slot_tys]. + [None] for a slot the checker invented -- see [Tast.fn.snames]. Recorded + here rather than recovered later because this scope list is the only place + that ever knows it. *) + mutable slot_names : string option list; mutable scope : (string * binding) list; (* innermost first *) (* Deferred forms, most recently registered first — which is also the order they run in. At milestone 4 [defer] is function-scoped (see [check_fn]), @@ -111,14 +116,51 @@ type ctx = { owner : string; } -let fresh_slot ctx ty = +(* [?name] is the source name, when there is one. It is optional so that the + several places that allocate a hidden slot say nothing and get [None] -- + a synthesized slot cannot accidentally acquire a name it was never given. *) +let fresh_slot ?name ctx ty = let s = ctx.slots in ctx.slots <- s + 1; ctx.slot_tys <- ty :: ctx.slot_tys; + ctx.slot_names <- name :: ctx.slot_names; s +(* Shadowing is legal -- [(let [v 11] (let [v 22] ...))] is two slots, both + named [v] -- and the debug info has nowhere to put the distinction. Every + [!DILocalVariable] is scoped to the subprogram, because the typed IR has no + block structure for a [!DILexicalBlock] to be built from, so two variables + called [v] land in one flat scope and lldb answers [p v] with whichever it + finds first. Measured, not assumed: it answers with the *outer* one, so it + prints 11 while the body it is stopped in is computing with 22, and the + inner binding is not listed at all. + + That is the one outcome worse than printing [s3]: a name the debugger is + confident about and wrong about. So a repeat of a name already bound in this + function gets a suffix, and both bindings are then visible and unambiguous. + [~] is the reader's delimiter and cannot occur in a source symbol (the same + reason [destructure~nth] is spelled that way), so [v~2] is visibly the + compiler's doing and can never collide with something the programmer wrote. + + This is a way of not lying, not a way of being right: [v] is still the outer + binding everywhere, including inside the inner one's extent. Scoping the + variables properly means emitting a [!DILexicalBlock] per [Let] and moving + the [llvm.dbg.declare]s out of the entry block to the binding sites, which + needs block structure this IR does not carry. *) let bind ctx name bty ~assignable = - let slot = fresh_slot ctx bty in + let taken n = List.exists (fun s -> s = Some n) ctx.slot_names in + let name' = + if not (taken name) then name + else + let rec go k = + let c = Printf.sprintf "%s~%d" name k in + if taken c then go (k + 1) else c + in + go 2 + in + let slot = fresh_slot ~name:name' ctx bty in + (* [ctx.scope] keeps the *source* name: the suffix is a debug-info artifact + and resolving [v] must still find the innermost binding. *) ctx.scope <- (name, { slot; bty; assignable }) :: ctx.scope; slot @@ -573,7 +615,7 @@ and check_handler_bind ctx ?want loc clauses body = (* Its own context: a fresh frame, an empty scope, and no way to reach the enclosing one. *) let hctx = - { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; + { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; in_defer = false; owner = "" } in (* The condition crosses as a pointer, because the handler runs while @@ -608,6 +650,7 @@ and check_handler_bind ctx ?want loc clauses body = ctx.env.lifted <- { Tast.name = fname; params = [ Types.Ptr ty ]; slots = Array.of_list (List.rev hctx.slot_tys); + snames = Array.of_list (List.rev hctx.slot_names); ret = Types.Unit; body = hbody; fdefers = []; fparent = Some ctx.owner; floc = c.Ast.hloc } :: ctx.env.lifted; @@ -1456,7 +1499,7 @@ let collect env (decls : Ast.decl list) = not check once no progress is left has a real error, so the last round is run without swallowing it. *) let infer (_, v) = - (check { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } v).Tast.ty in let pending = ref (List.rev !untyped) in @@ -1509,7 +1552,7 @@ let check_finite env = let check_fn env (fn : Ast.fn) : Tast.fn = let params, ret = Hashtbl.find env.fns fn.Ast.name in - let ctx = { env; ret; slots = 0; slot_tys = []; scope = []; defers = []; + let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = fn.Ast.name } in List.iter2 @@ -1579,12 +1622,13 @@ let check_fn env (fn : Ast.fn) : Tast.fn = in { Tast.name = fn.Ast.name; params; slots = Array.of_list (List.rev ctx.slot_tys); + snames = Array.of_list (List.rev ctx.slot_names); (* The same defers again, for the transfer exit path §5 describes. The normal path has them spliced into [body] above. *) ret; body; fdefers = ctx.defers; fparent = None; floc = fn.Ast.nloc } let check_global env (d : Ast.decl) : Tast.global option = - let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } in match d.Ast.d with | Ast.Defvar (n, _, init) -> @@ -1691,10 +1735,12 @@ let program (decls : Ast.decl list) : Tast.program = fst (program_with_env decls (* One expression, checked against a program that is already running. The frame is empty — a REPL expression has no parameters and no enclosing function — so the slots it needs are whatever its own [let]s allocate. *) -let expression env (e : Ast.expr) : Tast.expr * Types.t array = +let expression env (e : Ast.expr) : + Tast.expr * Types.t array * string option array = let ctx = - { env; ret = Types.Unit; slots = 0; slot_tys = []; scope = []; defers = []; + { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; in_handler = false; in_frames = None; in_defer = false; owner = "" } in let t = check ctx e in - (t, Array.of_list (List.rev ctx.slot_tys)) + (t, Array.of_list (List.rev ctx.slot_tys), + Array.of_list (List.rev ctx.slot_names)) diff --git a/lib/emit.ml b/lib/emit.ml index 3a85c50..3ca0d22 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1301,20 +1301,30 @@ let signature ~named (fn : Tast.fn) = visibility in a shared object is interposable: [@"flan.bump"] inside the module would resolve to the *host's* copy, so the installer would publish the function it was replacing and the reload would appear to do nothing. *) -(* The name a slot goes into the debug info under. The typed IR refers to - locals by index and nothing records what they were called -- [Check] knows, - in its scope list, and drops it. So a parameter gets the name the source - gave it, recovered by the driver and handed down in [pnames], and everything - else gets [s], which is the slot it actually is. A [let]-bound local - printing as [s4] is a real gap and it is named here rather than papered - over: fixing it means the typed IR carrying the name, which is a change to - [Tast]. *) -let slot_name ~pnames ~nparams i = - if i < nparams then - match List.nth_opt pnames i with - | Some n when n <> "" -> n - | _ -> Printf.sprintf "p%d" i - else Printf.sprintf "s%d" i +(* The name a slot goes into the debug info under. [Tast.fn.snames] carries the + source name of every slot the source named, parameters included, so that is + the answer wherever there is one. + + A slot with no name is one the compiler invented -- [dotimes]'s hidden + bound, the pair (min) and (max) evaluate their operands into -- and it keeps + [s], which is what it actually is. That is deliberate rather than a + fallback: a synthesized slot has no source name to print, and inventing a + plausible one would put a variable in the debugger that the programmer + cannot find in the file. [s4] is honest about being the frame's fourth slot. + + [snames] is indexed defensively because a driver may build a frame by + appending arrays ([Session]'s evaluation thunk does), and a short [snames] + should cost a name, not raise. *) +let slot_name ~pnames ~snames ~nparams i = + let named = if i < Array.length snames then snames.(i) else None in + match named with + | Some n when n <> "" -> n + | _ -> + if i < nparams then + match List.nth_opt pnames i with + | Some n when n <> "" -> n + | _ -> Printf.sprintf "p%d" i + else Printf.sprintf "s%d" i let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = let n = Array.length fn.Tast.slots in @@ -1372,7 +1382,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = dnode d (Printf.sprintf "!DILocalVariable(name: \"%s\"%s, scope: !%d, file: !%d, line: %d, type: !%d)" - (dstr (slot_name ~pnames ~nparams i)) arg sub file f.dline + (dstr (slot_name ~pnames ~snames:fn.Tast.snames ~nparams i)) + arg sub file f.dline (dty m d ty))) fn.Tast.slots) in diff --git a/lib/session.ml b/lib/session.ml index 540bd39..92851a7 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -574,7 +574,7 @@ let eval_expr ?(origin = "") t src : change = | [] -> fail Loc.unknown "nothing to evaluate" | _ :: f :: _ -> fail f.Form.loc "one expression at a time" in - let checked, base = Check.expression t.env (Parse.expr form) in + let checked, base, bnames = Check.expression t.env (Parse.expr form) in let c = { structs = t.program.Tast.structs; enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; @@ -589,7 +589,10 @@ let eval_expr ?(origin = "") t src : change = let name = Printf.sprintf "eval/%d" t.thunks in let thunk : Tast.fn = { Tast.name; params = []; ret = Types.Unit; body; fdefers = []; fparent = None; floc = loc; - slots = Array.append base (Array.of_list (List.rev c.slots)) } + slots = Array.append base (Array.of_list (List.rev c.slots)); + (* The expression's own [let]s keep their names; the slots [render] added + behind them are the walk's own scratch and have none to keep. *) + snames = Array.append bnames (Array.make (List.length c.slots) None) } in (* Built against the program but never spliced into it: an evaluation is not a declaration, and adding one would leave the session carrying an eval/N diff --git a/lib/tast.ml b/lib/tast.ml index 2f686dd..72cb264 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -113,6 +113,15 @@ type fn = { name : string; params : Types.t list; (* bound to slots 0 .. n-1, in order *) slots : Types.t array; (* the frame: one entry per slot *) + (* What the source called each slot, parallel to [slots]. [None] is a slot + the compiler made up and no one wrote a name for -- [dotimes]'s hidden + bound, the pair (min) and (max) evaluate their operands into, the slot a + tail expression goes through. Names are otherwise gone from this IR (see + the header); this is the one exception, and it exists so a debug build can + emit a [!DILocalVariable] that says [lo] where the source said [lo]. A + backend is free to ignore it entirely -- nothing is *resolved* through it, + and a slot is still only ever referred to by index. *) + snames : string option array; ret : Types.t; body : expr list; (* The defers again, innermost first. [body] already has them spliced onto diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 21ac026..28f42f7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1309,11 +1309,11 @@ ERR@7 unexpected token: not the kind the caller was reading (* 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"); + (* A let-bound local carries the name the source gave it. [Tast.fn] + records one per slot and [Check] fills it in at the binding, so + [(let [c ...)] is [c] in the debug info and not [s0] -- which is + what it used to be, and was the one honest gap in this picture. *) + ("!DILocalVariable(name: \"c\"", "a let-bound local, named by its source name"); ("!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") ]; @@ -1341,6 +1341,40 @@ ERR@7 unexpected token: not the kind the caller was reading print_endline "FAIL the transfer channel appeared as a local variable" end; + (* The two rules about a name that is not simply the source's own. + + A slot the compiler invented has no source name and keeps [s]: + [dotimes] evaluates its bound once into a hidden slot, and calling that + something plausible would put a variable in the debugger that is not in + the file. [i] is the programmer's and is named; the bound is not. + + And a shadowed name is disambiguated. Every [!DILocalVariable] is scoped + to the subprogram — the typed IR has no block structure to build a + [!DILexicalBlock] from — so two slots both called [v] leave lldb + answering [p v] with whichever it finds first. Measured: it answers with + the outer one, and does not list the inner at all, so the debugger is + confident and wrong. [~] cannot occur in a source symbol, so [v~2] is + unambiguous and visibly the compiler's. The prelude shadows in + [split-next], so this rule is load-bearing for the library too. *) + let ir = + debug_ir "(defn spin [n i32] i32\n\ + \ (let [v 11]\n\ + \ (let [v 22]\n\ + \ (dotimes [i n] (set v (+ v i)))\n\ + \ v)))\n\ + (defn main [] i32 (spin 3))\n" + 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) + [ ("!DILocalVariable(name: \"v\"", "the outer of two shadowed bindings"); + ("!DILocalVariable(name: \"v~2\"", "the inner one, disambiguated"); + ("!DILocalVariable(name: \"i\"", "a dotimes counter, which is the source's"); + ("!DILocalVariable(name: \"s4\"", "dotimes' hidden bound, which is not") ]; + (* LLVM's own verifier, over both entry points. String needles cannot see a DISubprogram the compile unit does not reach, or a call without a !dbg inside a function that has debug info — and that second one is a @@ -1513,7 +1547,13 @@ ERR@7 unexpected token: not the kind the caller was reading 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" ]; + "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5"; + (* And the let-bound local under its own name rather than [s0], which + is the gap this closes. Only the name is claimed here: a name + breakpoint stops on the function's first line, which is before the + [let] has stored anything, so the value at this point is whatever + the frame happened to hold. The value is pinned just below. *) + "(int) bump" ]; (* 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. *) @@ -1521,6 +1561,26 @@ ERR@7 unexpected token: not the kind the caller was reading "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" ]; + (* The value, which the case above deliberately does not claim. Every + [!DILocalVariable] is scoped to the whole subprogram and carries the + function's own line, so a let-bound local is nominally in scope from + entry and reads as garbage until its binding runs. Breaking *after* + the binding is what makes the value load-bearing: [bump] is n+1 and n + is 41, so 42 is the only right answer, and a [!DILocalVariable] + attached to the wrong alloca prints something else. That is the check + that a name which is present is also not a lie. *) + let exe = debug_compile "programs/debug.flan" in + let _, text = + lldb_run exe + [ "breakpoint set --file debug.flan --line 20"; "run"; + "frame variable bump" ] + in + if not (contains text "(int) bump = 42") then begin + incr failures; + print_endline "FAIL lldb: a let-bound local's value after its binding"; + print_endline text + end; + (* 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 From d0a8339bb5d91331aab7b9e2759f7bfd1a59dca3 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 05:14:03 +0700 Subject: [PATCH 2/3] DWARF in a redefinition, and one flag that means it everywhere MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Emit.redefinition has taken ~debug since it was written and was tested with it; Session.eval never passed it, so every body installed by C-c C-c lost its debug info in the running process. Passing it alone would have been half a fix. Build.shared is what forces -O0, and dev.ml built modules at -O2, so the llvm.dbg.declares would have been emitted and then deleted by mem2reg: a line table, and no locals. And a module with DWARF loaded into a host without it lines up against nothing. So it is one flag — flan dev --debug and flan reload --debug — and it sets the host build, the module builds and the emitted metadata together. Off by default: a debug build is an -O0 build, and quietly making every reloaded body -O0 changes the frame time of the one function you are iterating on, in the loop whose point is watching that number. What a dlopen'd module does to a breakpoint, measured against the reload fixture rather than reasoned about: - lldb reads the new module's DWARF on the dlopen and says so: "1 location added to breakpoint 3". - A breakpoint set by NAME gains a second location either way, so dlopen was never the difficulty. What the line table buys is that it stops with source instead of disassembly. - A FILE AND LINE breakpoint on the new body resolves only with it; without, it sits at locations = 0 (pending) forever. - A FILE AND LINE breakpoint on the HOST's copy stays pinned at locations = 1. That is correct, not stale: the old body is still mapped and every call site that has not gone through its cell again still reaches it. - The stack crosses intact — a frame in the reloaded .so and the one below it in the host each name their own .flan file. (lldb) frame variable (long) step = 10 (long) prior = 11 The transcripts are in flan-dape.el, replacing the note that said the module carries no DWARF yet. flan-cnr.el's stack pane was refusing for the wrong reason. DWARF was never its gap; nothing is attached to the stopped program, and a socket cannot read another process's frames. Reworded to say that. Source interleaving in the disassembly buffer is unblocked and not done: objdump -dS interleaves a --debug module's Flan source correctly, so Dev.asm_of needs the -S and a parse_listing that tolerates source lines. --- NEXT.md | 42 ++++++++++++++++++++--------- bin/main.ml | 22 +++++++++++---- emacs/flan-cnr.el | 4 +-- emacs/flan-dape.el | 64 ++++++++++++++++++++++++++++++++------------ lib/dev.ml | 26 ++++++++++++++---- lib/session.ml | 23 +++++++++++++--- test/test_agent.ml | 4 +-- test/test_session.ml | 46 ++++++++++++++++++++++++++----- 8 files changed, 178 insertions(+), 53 deletions(-) diff --git a/NEXT.md b/NEXT.md index b73917f..5d47830 100644 --- a/NEXT.md +++ b/NEXT.md @@ -49,15 +49,37 @@ Four agents are working these in parallel worktrees. Listed so a session reading 3. **The first ten raylib core examples**, plus the window and input bindings they need. The deliverable is the *language gap list* as much as the ported files — sand.flan is the only real raylib program today, so this is the first time the language is pushed by code it was not designed around. -4. **Names in DWARF.** The two items under "One line away" below, promoted here because the inspector and the - conditions buffer are only as good as what lldb can say: let-bound locals print as `s0`, `s2` because `Tast` refers - to them by slot index and `Check` drops the names, and `Session.eval` never passes the `~debug` that - `Emit.redefinition` already takes and is already tested for. The second also unblocks source interleaving in the - disassembly buffer. +4. **Names in DWARF.** *Done.* `Tast.fn` carries `snames` beside `slots`, so a let-bound local is its own name under + lldb instead of `s0`; a slot the compiler invented keeps `s`, because a synthesized slot has no source name + and inventing one puts a variable in the debugger that is not in the file. Shadowing had to be decided rather than + assumed: every `!DILocalVariable` is scoped to the subprogram — the typed IR has no block structure to build a + `!DILexicalBlock` from — so two slots called `v` left lldb answering `p v` with the outer one while the body computed + with the inner, and not listing the inner at all. A repeat now gets a `~2` suffix, which is unambiguous because `~` + cannot occur in a source symbol. That is a way of not lying, not a way of being right; the real fix is a lexical + block per `Let` and the `llvm.dbg.declare`s moved out of the entry block, and it is the one thing left here. -**DWARF is not missing, and `flan-cnr.el`'s stack pane reads as though it were.** `flan build --debug` emits it and -`flan-dape.el` drives lldb with it. What the break loop lacks is DWARF *in a dev build* — a `flan dev` process is not a -`--debug` one. Worth rewording that refusal so it names the real gap. + And `flan dev --debug` now builds the host *and* every redefinition module with DWARF. One flag, because it is one + decision — measured, not reasoned: a line breakpoint needs a line table on the host to fire before the first + `C-c C-c` and one in each module to still be firing after. Off by default, because a debug build is an `-O0` build + and silently making every reloaded body `-O0` changes the frame time of the function being iterated on. + +**What a dlopen'd redefinition module does to a breakpoint, measured.** lldb picks the new module's DWARF up on the +`dlopen` and says so — "1 location added to breakpoint 3". A breakpoint set by *name* gains a second location either +way, so dlopen was never the difficulty; what the module's line table buys is that it stops with **source** rather than +disassembly, and that a *file and line* breakpoint on the new body resolves at all — it sits at `locations = 0 +(pending)` forever without one. A file-and-line breakpoint on the **host's** copy stays pinned at `locations = 1`, which +is correct rather than stale: the old body is still mapped and every call site that has not gone through its cell again +still reaches it. The stack crosses the boundary intact — a frame in the reloaded `.so` and the frame below it in the +host each name their own `.flan` file. The transcripts are in `emacs/flan-dape.el`, under "Reloading and breakpoints". + +**Source interleaving in the disassembly buffer is unblocked, and not done.** `Dev.asm_of` runs `objdump -d`; with a +`--debug` module `objdump -dS` interleaves the Flan source correctly (verified). What it needs is the `-S` and a +`parse_listing` that tolerates source lines among the instructions. + +**`flan-cnr.el`'s stack pane was refusing for the wrong reason** and now names the real one. DWARF was never the gap: +what is missing is anything *attached* to the stopped program. That buffer reaches it over the daemon's socket, and a +socket cannot read another process's frames — the break loop stopped itself, it is not being debugged. It wants either +an unwinder in the agent or lldb on the same pid. ### Managed classes are planned. Do not start them. @@ -565,10 +587,6 @@ Sixty mutations, nineteen left the whole suite green. The severe cluster is clos - **`match` over enums.** Fully desugarable, wanted, and blocked only by `Ast.pattern` needing a keyword case, which `load.ml` matches exhaustively. -- **[in flight]** **DWARF for a redefinition module.** `Emit.redefinition` takes `~debug` and is tested; `Session.eval` does not pass - it. That also unblocks source interleaving in the disassembly buffer. -- **[in flight]** **Let-bound locals print as `s0`, `s2`** under lldb. Parameters get their real names; `Tast` refers to the rest by - slot index and `Check` drops the names. - **`Build.executable` returns only `out`**, so the daemon recovers the host `.ll` by recomputing `Build.workdir ()`. ### Deferred with a reason diff --git a/bin/main.ml b/bin/main.ml index a77137e..22d1794 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -202,13 +202,22 @@ let () = against — and it owns the build, which is what makes its layout rules describe the process that is actually running. *) | _ :: "dev" :: path :: rest -> + (* --debug builds the host *and* every module this daemon sends with DWARF, + which is one flag because it is one decision: a line breakpoint in a + .flan buffer needs a line table on the host to fire at all, and one in + each redefinition module to still be firing after C-c C-c. It implies + -O0 on both, so it is asked for rather than assumed. *) + let debug = List.mem debug_flag rest in + let rest = List.filter (fun a -> not (is_flag a)) rest in let sock = match rest with | [ "-s"; s ] -> s | [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock" - | _ -> prerr_endline "usage: flan dev [-s socket]"; exit 2 + | _ -> + prerr_endline "usage: flan dev [-s socket] [--debug]"; + exit 2 in - with_errors path (fun () -> Flan.Dev.start ~file:path ~sock) + with_errors path (fun () -> Flan.Dev.start ~debug ~file:path ~sock ()) (* One redefinition, built the way an editor will ask for it: a session over the program the process was built from, and a file of the forms that @@ -216,19 +225,22 @@ let () = is one a running process can be told at all — neither of which a command given only a list of function names could. *) | _ :: "reload" :: prog :: forms :: rest -> + let debug = List.mem debug_flag rest in + let rest = List.filter (fun a -> not (is_flag a)) rest in let out = match rest with | [ "-o"; o ] -> o | [] -> Filename.remove_extension (Filename.basename forms) ^ ".so" | _ -> - prerr_endline "usage: flan reload [-o out.so]"; + prerr_endline + "usage: flan reload [-o out.so] [--debug]"; exit 2 in with_errors forms (fun () -> - let t, _ = Flan.Session.create ~file:prog in + let t, _ = Flan.Session.create ~debug ~file:prog () in let src = In_channel.with_open_bin forms In_channel.input_all in let c = Flan.Session.eval ~origin:forms t src in - let opts = { Flan.Build.default with dev = true } in + let opts = { Flan.Build.default with dev = true; debug } in let timing = Flan.Build.shared ~opts ~ir:c.Flan.Session.ir ~out () in Printf.eprintf "%s %s llc %.1fms ld %.1fms\n" out (String.concat " " c.Flan.Session.fns) timing.Flan.Build.llc_ms diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 525aaa8..9e0d8c6 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -78,9 +78,9 @@ from fixtures, and so `flan-dev.el' is named in one place.") (params . "restart arguments are checked at run time against a frame that does not record its arity [needs a field in the restart frame]") (stack - . "a Flan build carries no frame metadata, so there is nothing to walk the stopped stack with [blocked: needs DWARF]") + . "nothing here is attached to the stopped program. DWARF is not the gap and has not been for a while: `flan build --debug' emits it, `flan dev --debug' now builds the host and every redefinition module with it, and lldb walks a stack that crosses from a reloaded .so back into the host naming both sides' .flan files. But this buffer reaches the program over the daemon's socket, and a socket cannot read another process's frames — the break loop stopped itself, it is not being debugged. So this wants either an unwinder in the agent, beside `flan_rt.c', or lldb attached to the same pid and this buffer reading it [needs one of those two, not DWARF]") (locals - . "reading a stopped frame's locals needs both the frame layout and a renderer aimed at an address rather than at an expression [blocked: needs DWARF, and the same thunk the condition's fields need]")) + . "same reason as the stack above it, plus a renderer aimed at an address rather than at an expression. The names and types are in the DWARF now — a let-bound local is its own name there, not `s0' — so whatever walks the frames can read them; nothing is walking the frames [needs the same attachment, and the same thunk the condition's fields need]")) "Why a section of this buffer is empty, by name.") (defun flan-cnr--why (key) diff --git a/emacs/flan-dape.el b/emacs/flan-dape.el index 84def30..9ab2b31 100644 --- a/emacs/flan-dape.el +++ b/emacs/flan-dape.el @@ -27,8 +27,8 @@ ;; - a --dev build and a --debug build are different builds, and M-x ;; flan-debug does not attach to the program `flan dev' is running; ;; - across a redefinition a breakpoint set by NAME gains a second location -;; and both stay live, while one set by FILE AND LINE stops firing — -;; because the redefinition module carries no DWARF yet. +;; and both stay live; one set by FILE AND LINE follows the reload if the +;; module was built with `flan dev --debug', and does not otherwise. ;;; Code: @@ -207,23 +207,53 @@ common case is one command rather than a config prompt." ;; Both fire, and both are correct — 1.1 is not stale, it is the body the old ;; call sites still run. That is `dape-breakpoint-global', which sets by name. ;; -;; A breakpoint set by FILE AND LINE does not follow, and the reason is not -;; that dape pinned it to an address. It stays at locations = 1 because the -;; redefinition module carries no line table for it to resolve against. Given -;; one it does follow: a pending breakpoint on a file the executable had never -;; heard of went from "no locations (pending)" to "1 location added" the moment -;; a .so with DWARF for that file was dlopened, and stopped with full source. -;; So the gap is exactly one missing thing, and nothing about dlopen. +;; A breakpoint set by FILE AND LINE depends on how the module was built, and +;; the difference is a line table and nothing about dlopen. Both halves were +;; measured against the same host, one redefinition module built each way. ;; -;; That missing thing, by name: `Emit.redefinition' takes a ~debug argument and -;; `Session.eval' does not pass it, so `flan reload' and the `flan dev' daemon -;; build modules without DWARF. Until they do, a reloaded body breaks by name -;; and shows disassembly instead of source, and a line breakpoint in the .flan -;; buffer silently stops firing after the first C-c C-c. lib/session.ml is the -;; dev loop's file and is not this one's to change. +;; Without DWARF in the module the line breakpoint stays where it was: ;; -;; So, for now: debug with `dape-breakpoint-global' if you are also reloading, -;; and use line breakpoints for a program you are only running. +;; 2: file = 'v2local.flan', line = 25, locations = 0 (pending) +;; +;; and the name breakpoint still gains its second location — so dlopen was +;; never the problem — but stops into disassembly, because there is no source +;; to show: +;; +;; frame #0: 0x7ffff7fba190 nodbg-v2.so`flan.bump +;; -> 0x7ffff7fba190 <+0>: pushq %rbx +;; +;; With DWARF in the module, the same breakpoint resolves on the dlopen — lldb +;; prints "1 location added to breakpoint 3" as the module loads — and stops +;; with source and named locals: +;; +;; 3: file = 'v2local.flan', line = 25, locations = 1, resolved = 1 +;; 3.1: where = v2.so`flan.bump + 78 at v2local.flan:25:21, resolved +;; +;; (lldb) frame variable +;; (long) step = 10 +;; (long) prior = 11 +;; +;; The stack crosses the boundary intact, which is the part worth knowing: a +;; frame in the reloaded .so and the frame below it in the host each name their +;; own .flan file, and the C host below both. +;; +;; frame #0: v2.so`flan.bump at v2local.flan:25:21 +;; frame #2: host`flan.outer at reload.flan:38:20 +;; frame #3: host`main at reload_host.c:94:44 +;; +;; A breakpoint set by FILE AND LINE on the *host's* copy stays at locations = 1 +;; and does not move. That is correct rather than stale: the old body is still +;; mapped and every call site that has not gone through the cell again still +;; reaches it, so pinning there is the only honest thing to do. +;; +;; How to get it: `flan dev --debug'. It is one flag on purpose — the host +;; needs a line table for a breakpoint to fire before the first C-c C-c, and +;; each module needs one for it to still be firing after — and it is off by +;; default because a debug build is an -O0 build, which is not what you want +;; under a frame budget unless you asked for it. +;; +;; So: with `flan dev --debug', line breakpoints work across a reload. Without +;; it, debug with `dape-breakpoint-global', which sets by name. (provide 'flan-dape) ;;; flan-dape.el ends here diff --git a/lib/dev.ml b/lib/dev.ml index 0cb1dfc..1de7937 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -321,7 +321,9 @@ let eval t ~code ~origin = nothing else on this machine still has that text. *) let ll = Filename.concat t.dir (Printf.sprintf "m%d.ll" t.n) in write_file ll c.Session.ir; - (match Build.shared ~opts:{ Build.default with Build.dev = true } + (match Build.shared + ~opts:{ Build.default with Build.dev = true; + Build.debug = t.session.Session.debug } ~ir:c.Session.ir ~out () with | timing -> (match deliver t out with @@ -357,7 +359,9 @@ let eval_expr t ~code ~origin = let before = match result t with Some (g, _) -> g | None -> 0L in t.n <- t.n + 1; let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in - (match Build.shared ~opts:{ Build.default with Build.dev = true } + (match Build.shared + ~opts:{ Build.default with Build.dev = true; + Build.debug = t.session.Session.debug } ~ir:c.Session.ir ~out () with | _ -> (match deliver t out with @@ -874,7 +878,13 @@ let serve t fd = in go () -let start ~file ~sock = +(* [debug] is off by default, which keeps [flan dev] exactly what it was: a + -O2 host and -O2 modules. It is opt-in rather than always-on because a debug + build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg + deletes it — and silently making every reloaded body -O0 would change the + frame time of the one function you are iterating on, in the loop whose whole + point is watching that number. *) +let start ?(debug = false) ~file ~sock () = let t0 = Unix.gettimeofday () in (* Absolute, because every location this daemon ever reports is derived from it and an editor is not in this process's working directory. [flan dev @@ -882,7 +892,7 @@ let start ~file ~sock = "src/game.flan:12:7", which the editor can only resolve by guessing which directory it was relative to. *) let file = try Unix.realpath file with Unix.Unix_error _ -> file in - let session, l = Session.create ~file in + let session, l = Session.create ~debug ~file () in let dir = Filename.concat (Filename.get_temp_dir_name ()) (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) @@ -895,9 +905,15 @@ let start ~file ~sock = probably was. [Build.executable] leaves it in its own working directory under the module's basename; it is moved here so that nothing else in this process can reuse the name. *) + (* The host and the modules are one decision. DWARF in a redefinition is + only half a debuggable dev loop: lldb re-resolves a *name* breakpoint + against each module as it loads either way, but a breakpoint set on a line + in the .flan buffer needs a line table on both sides — the host's to fire + before the first C-c C-c, the module's to follow the reload. *) ignore (Build.executable - ~opts:{ Build.default with Build.dev = true; Build.keep = true } + ~opts:{ Build.default with Build.dev = true; Build.keep = true; + Build.debug } ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags session.Session.host ~out:exe); let host_ll = Filename.concat dir "host.ll" in (try diff --git a/lib/session.ml b/lib/session.ml index 92851a7..2fa492d 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -36,6 +36,13 @@ type t = { host : Tast.program; (* what the process was built from *) pkgs : Load.pkg list; (* alias, directory, names owned *) mutable thunks : int; (* expression evaluations so far *) + (* Whether the modules this session emits carry DWARF. It belongs to the + session rather than to each call because it has to match the process the + modules are loaded into: a redefinition with debug info, dlopened into a + host built without it, gives a debugger a second module to resolve names + against and nothing to line up the host's own frames with. Both ends are + set from one flag — see [Dev.start]. *) + debug : bool; } let fail = Loc.fail @@ -59,11 +66,11 @@ let rec same_const (a : Tast.expr) (b : Tast.expr) = && List.for_all2 same_const xs ys | _ -> false -let create ~file = +let create ?(debug = false) ~file () = let l = Load.program ~file (Parse.program (Reader.read_file file)) in let p, env = Check.program_with_env l.Load.decls in ({ file; decls = l.Load.decls; program = p; env; host = p; pkgs = l.Load.pkgs; - thunks = 0 }, l) + thunks = 0; debug }, l) (* Which package a file being edited belongs to, if any. @@ -346,7 +353,10 @@ let eval ?(origin = "") t src : change = program.Tast.globals) names in - let ir = Emit.redefinition ~dev:true ~known:(known t) ~consts program ~fns in + let ir = + Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~consts program + ~fns + in let allocates = List.exists (fun (g : Tast.global) -> not (known t g.Tast.gname)) @@ -603,6 +613,11 @@ let eval_expr ?(origin = "") t src : change = externs = t.program.Tast.externs @ externs } in let ir = - Emit.redefinition ~dev:true ~known:(known t) ~call:name program ~fns:[ name ] + (* The thunk gets debug info on the same flag as everything else. It is a + function nobody sets a breakpoint on by name, but it is a frame on the + stack when the expression signals, and a frame the debugger cannot name + is the thing the conditions buffer is trying to stop showing. *) + Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name + program ~fns:[ name ] in { ir; names = []; fns = []; installs = true } diff --git a/test/test_agent.ml b/test/test_agent.ml index 4f16c62..2143080 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -67,7 +67,7 @@ let () = through it rather than calling Emit directly is the point: it is what knows [tick] is a name the host has, so the module binds to its cell as a symbol instead of inventing a registry entry nobody publishes. *) - let t, l = Session.create ~file:"programs/agent.flan" in + let t, l = Session.create ~file:"programs/agent.flan" () in (* A dev build, because that is what has cells to install into and exports them. The agent's own C and its -lpthread come from the package. *) @@ -173,7 +173,7 @@ let () = and they differ, so a loop that always took the same restart fails. *) let bsock = tmp "break.sock" and bout = tmp "break.out" in (try Sys.remove bsock with Sys_error _ -> ()); - let bt, bl = Session.create ~file:"programs/break.flan" in + let bt, bl = Session.create ~file:"programs/break.flan" () in let bexe = tmp "break" in ignore (Build.executable ~opts:dev ~csrcs:bl.Load.csrcs ~lflags:bl.Load.lflags diff --git a/test/test_session.ml b/test/test_session.ml index b2b8281..c5da50b 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -24,7 +24,7 @@ let checked_program file = (Load.program ~file (Parse.program (Reader.read_file file))).Load.decls let refuses ?(file = "programs/reload.flan") name src reason = - let t, _ = Session.create ~file in + let t, _ = Session.create ~file () in match Session.eval t src with | _ -> fail "%s was accepted" name | exception Loc.Error (_, msg) -> @@ -70,7 +70,7 @@ let () = "changes layout"; (* An ordinary redefinition, and what the session works out about it. *) - let t, _ = Session.create ~file:"programs/reload.flan" in + let t, _ = Session.create ~file:"programs/reload.flan" () in let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 5)) counter)" in if not c.Session.installs then fail "a redefined function had nothing to install"; if c.Session.fns <> [ "bump" ] then @@ -83,6 +83,40 @@ let () = if has c.Session.ir "flan_dev_cell" then fail "a name the host has went through the registry"; + (* DWARF in a redefinition module, which is a property of the session and + not of the call. [Emit.redefinition] has taken a ~debug argument all + along and was tested with it; what was missing was anyone passing it, so + every body installed by C-c C-c lost its debug info in a running process. + The defect was one unpassed argument, so the test is that the argument + arrives — asserted on the emitted text, which is the only place it shows. + + Both directions matter. A session that always emitted debug info would + force -O0 on every reloaded body ([Build.shared] does that, and must), + which would change the frame time of the one function being iterated on. + Off unless asked for is the behaviour, so off is asserted too. *) + let dt, _ = Session.create ~debug:true ~file:"programs/reload.flan" () in + let dc = + Session.eval dt + "(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))" + in + if not (has dc.Session.ir "!DILocalVariable(name: \"step\"") then + fail "a debug session's redefinition carries no name for its local"; + if not (has dc.Session.ir "!DISubprogram(name: \"bump\"") then + fail "a debug session's redefinition carries no subprogram"; + let pt, _ = Session.create ~file:"programs/reload.flan" () in + let pc = + Session.eval pt + "(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))" + in + if has pc.Session.ir "!DILocalVariable" then + fail "a plain session's redefinition carries debug info it was not asked for"; + + (* The same for an expression evaluation, which takes the other path out of + the session and so can lose the flag on its own. *) + let ec = Session.eval_expr dt "(+ counter 1)" in + if not (has ec.Session.ir "!DISubprogram") then + fail "a debug session's eval thunk carries no debug info"; + (* A form that does not check must leave the session exactly as it was. This is the one that decides whether a REPL survives a typo. *) (match Session.eval t "(defn bump [] i64 nonsense)" with @@ -141,7 +175,7 @@ let () = (* A file with imports, re-evaluated whole — the C-c C-k case. The session keeps the *expanded* declarations, so the package's names are replaced in place rather than appended a second time and rejected as duplicates. *) - let t, _ = Session.create ~file:"../sand.flan" in + let t, _ = Session.create ~file:"../sand.flan" () in let src = In_channel.with_open_bin "../sand.flan" In_channel.input_all in (match Session.eval t src with | c -> @@ -157,7 +191,7 @@ let () = importer and written nowhere in the file, so the path is the only thing that can decide it — which is why it is derived here and not sent by the editor. *) - let t, _ = Session.create ~file:"../sand.flan" in + let t, _ = Session.create ~file:"../sand.flan" () in (match Session.eval ~origin:"../vendor/agent/agent.flan" t "(defn poll [] i32 (poll-raw))" @@ -172,7 +206,7 @@ let () = member of a directory, so matching on the directory alone would answer "not a package" — and the failure is the silent one above: the form splices as a bare [step] and the running program keeps the one it had. *) - let t2, _ = Session.create ~file:"programs/sand-headless.flan" in + let t2, _ = Session.create ~file:"programs/sand-headless.flan" () in (match Session.eval ~origin:"../sand.flan" t2 "(defn step [] Unit (do))" with | c -> if c.Session.fns <> [ "sand/step" ] then @@ -194,7 +228,7 @@ let () = must not take a registry slot either — there are 4096 of those and an expression evaluated in a loop would exhaust them. A module that publishes a body can never say this; its whole purpose is to leave a pointer. *) - let t, _ = Session.create ~file:"programs/reload.flan" in + let t, _ = Session.create ~file:"programs/reload.flan" () in let e = Session.eval_expr t "(+ 1 2)" in if not (has e.Session.ir "@flan_reload_transient") then fail "an expression's module did not declare itself unloadable"; From 4723e49e4de534d2d9fadbac7f1a9fb285b13a0b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 05:17:13 +0700 Subject: [PATCH 3/3] Ask the object, not the text, whether the daemon built with -g MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- test/test_dev.ml | 81 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) 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"