From fef6ae04f6464c33dcb8d73cba4192d79b9d9153 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 19:38:40 +0700 Subject: [PATCH] A failed build is a refusal, and a refusal leaves the session standing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The daemon caught Loc.Error at each op and nothing else. That was survivable while the frontend was the only thing that could refuse a form; it is not now that expansion is part of evaluating. Both C-c C-c and C-x C-e run a clang driver through Build.macro_module, which answers with an exit status and a Failure, and a dlopen that finds no symbol answers with another one. Neither is a Loc.Error, so neither was answered, and an exception past serve is not a refused evaluation — it is a dead daemon with the program still on screen and a closed socket waiting for the editor's next request. The boundary is now one place, around the whole of a request, rather than a new arm at each of the dozens of calls. Out_of_memory, Stack_overflow and Sys.Break go through it: those say the process cannot continue, and answering "error" to them would claim a session survived something it did not. Everything else is about the form that was sent, and the message it carries is the one the user can act on, so a clang exit status reaches :message instead of being flattened to "internal error". The session's own state goes with it. Session.eval wrote the imported macro set above the checker, so a form that did not check left the session holding a package's macros and none of its declarations; it is held and committed at the bottom with decls, program and env. Session.eval_expr committed the generic copies it had instantiated before emitting the module that carries them, which is the session believing it holds a body nothing was written for; that assignment moved below Emit. Both are pinned. test_session drives the two rollbacks in process, and test_dev drives a real daemon whose macro module cannot be built — the expression path and the redefinition path, each followed by the same evaluation succeeding and by the session still knowing the program. --- lib/dev.ml | 100 ++++++++++++++- lib/session.ml | 33 +++-- test/programs/dev-robust.flan | 28 +++++ test/test_dev.ml | 227 ++++++++++++++++++++++++++++++++++ test/test_session.ml | 59 +++++++++ 5 files changed, 435 insertions(+), 12 deletions(-) create mode 100644 test/programs/dev-robust.flan diff --git a/lib/dev.ml b/lib/dev.ml index 10e4b9c..82ac227 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -2235,6 +2235,67 @@ let handle t req = | Some op -> error ("unknown op: " ^ op) | None -> error "no :op" +(* ── The request boundary ──────────────────────────────────────────── *) + +(* Every op above answers with a reply; this is what makes that true for the + ones that raise instead of returning. + + The ops used to catch [Loc.Error] each at its own call site, which was + enough while the frontend was the only thing that could refuse a form. It is + not any more: expansion is part of evaluating, so both [eval] and + [eval-expr] now run a clang driver — [Build.macro_module] fails with + [Failure], a macro module that will not dlopen fails with [Failure] out of + [Dynload], and a file that moved fails with [Sys_error]. None of those is a + [Loc.Error], so none of them was answered, and an exception that escapes + [serve] is not a refused evaluation: it is a dead daemon. The program is + still on screen, the session is gone, and the editor's next request finds a + closed socket. + + So the boundary is here, once, around the whole of a request — rather than + a new arm at each of the dozens of calls, which is the arrangement that let + this happen in the first place. NEXT.md's rule is that a form that does not + check leaves the session exactly as it was, and that is only true if every + way a build or a check can fail comes back as a reply. + + What is deliberately *not* caught: [Out_of_memory], [Stack_overflow] and + [Sys.Break]. Those three say the process cannot continue, or that someone at + the terminal asked it to stop — they are not statements about the form that + was sent, and answering "error" to them would be claiming the session + survived something it did not. Everything else is about the form: a clang + exit status, a dlopen with no such symbol, a missing file. *) +let fatal = function + | Out_of_memory | Stack_overflow | Sys.Break -> true + | _ -> false + +(* The message an editor shows. A [Failure] out of the clang driver carries + the compiler's own words and a [Sys_error] carries the path, so they are + passed through as they are: "internal error" for either would throw away + the only part of the reply anybody can act on. The catch-all keeps the + exception's name, which at least says which of these arms to add next. *) +let message_of_exn = function + | Loc.Error { Loc.dmsg = m; _ } -> m + (* Only a whole-file driver raises the list and the daemon evaluates one + form — but [lib/parse.ml] says in as many words that a list arriving here + was a dead session, so it is answered rather than left to the catch-all + to print as a constructor name. *) + | Loc.Errors ds -> + String.concat "; " (List.map (fun (d : Loc.diag) -> d.Loc.dmsg) ds) + | Failure m | Sys_error m -> m + | Unix.Unix_error (e, fn, arg) -> + Printf.sprintf "%s: %s%s" fn (Unix.error_message e) + (if arg = "" then "" else " (" ^ arg ^ ")") + | e -> "internal error: " ^ Printexc.to_string e + +(* Shaped exactly as the [Loc.Error] arms it replaces: [:loc] where there is + one to give, and nothing where there is not — an editor that highlights a + span must not be handed a made-up one. *) +let reply_of_exn e = + match e with + | Loc.Error { Loc.dloc = l; _ } + | Loc.Errors ({ Loc.dloc = l; _ } :: _) -> + error ~loc:(Loc.to_string l) (message_of_exn e) + | _ -> error (message_of_exn e) + (* ── The loop ──────────────────────────────────────────────────────── *) (* One connection at a time. An editor is one client, evaluations are @@ -2248,12 +2309,43 @@ let serve t fd = let rec go () = match Wire.recv fd with | src -> - let op, reply = + (* Parsed once, and the verb taken out of it before anything that can + fail: [close] has to be honoured even when the handler for it did not + return normally, and a tuple whose two halves are [Wire.string_field] + and [handle] leaves that to an evaluation order OCaml does not + promise. *) + let parsed = match Wire.parse src with - | req -> (Wire.string_field req "op", handle t req) - | exception Loc.Error { Loc.dmsg = m; _ } -> (None, error ("bad request: " ^ m)) + | req -> Either.Left req + | exception e when not (fatal e) -> + Either.Right (error ("bad request: " ^ message_of_exn e)) in - Wire.send fd (with_output t (with_break t reply)); + let op = + match parsed with + | Either.Left req -> Wire.string_field req "op" + | Either.Right _ -> None + in + let reply = + match parsed with + | Either.Right r -> r + | Either.Left req -> + (match handle t req with + | r -> r + | exception e when not (fatal e) -> reply_of_exn e) + in + (* The two annotations are inside the boundary as well, and not because + they are likely to raise: [with_break] asks the program for its state + and [with_output] drains its pipe, so they touch the same things the + ops do. A reply that raised on its way out would be a reply never + sent, which is the same dead session one line lower down. The + fallback is the unannotated reply — worse than a full one, and the + whole point is that the editor gets an answer. *) + let annotated = + match with_output t (with_break t reply) with + | r -> r + | exception e when not (fatal e) -> reply + in + Wire.send fd annotated; if op = Some "close" then true else go () | exception Wire.Closed -> false | exception Unix.Unix_error _ -> false diff --git a/lib/session.ml b/lib/session.ml index 92a1ce9..364a40a 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -326,6 +326,7 @@ let eval ?(origin = "") ?pause t src : change = why the accumulated list is the post-Load one: re-evaluating a file that imports something would otherwise append a second copy of the import and the duplicate-name pass would reject it. *) + let macros = ref t.macros in let incoming = let l = Load.program ~file:t.file forms in (* An evaluated import *adds* to the session's set, so a macro brought in @@ -340,8 +341,16 @@ let eval ?(origin = "") ?pause t src : change = name collision, and what [Load] just read off disk is newer than what the session has been holding: editing a macro in a package and reloading the file that imports it has to expand the new body. The - other order would keep the stale one and say nothing. *) - t.macros <- Load.macro_union l.Load.macros t.macros; + other order would keep the stale one and say nothing. + + Held here and committed at the bottom with everything else, rather than + assigned on the spot: this is above the checker, and the session's rule + is that a form which does not check leaves it exactly as it was — + macros included. Nothing between here and there reads [t.macros]: + [Load.program] puts the imported set in front of the parse it drives + itself, and the checker below is handed declarations that are already + parsed. *) + macros := Load.macro_union l.Load.macros t.macros; let ds = l.Load.decls in match package_of t origin with | None -> ds @@ -480,6 +489,10 @@ let eval ?(origin = "") ?pause t src : change = (fun (g : Tast.global) -> not (known t g.Tast.gname)) program.Tast.globals in + (* Every one of these together, and after the last thing that can raise: + until this line the session is still the one the evaluation started + against, which is what makes a refusal cost nothing. *) + t.macros <- !macros; t.decls <- decls; t.program <- program; t.env <- env; @@ -1162,12 +1175,6 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ]; externs = t.program.Tast.externs @ externs } in - (* The copies stay in the session's program, unlike the thunk: the thunk is - not a declaration and there is nothing to keep, but a copy that has been - built and loaded *is* part of the running process from here on, and - forgetting it would generate a second one under the same name at the next - evaluation. *) - t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh }; let ir = (* 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 @@ -1176,4 +1183,14 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name program ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ name ]) in + (* The copies stay in the session's program, unlike the thunk: the thunk is + not a declaration and there is nothing to keep, but a copy that has been + built and loaded *is* part of the running process from here on, and + forgetting it would generate a second one under the same name at the next + evaluation. + + After [Emit], not before it: the session must not come to believe it holds + a body that no module was ever written for. A daemon that answers and has + lost track of what the program contains is worse than one that died. *) + t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh }; { ir; names = []; fns = []; installs = true } diff --git a/test/programs/dev-robust.flan b/test/programs/dev-robust.flan new file mode 100644 index 0000000..2f1f321 --- /dev/null +++ b/test/programs/dev-robust.flan @@ -0,0 +1,28 @@ +;;;; A program to send failing evaluations at, for as long as it takes. +;;;; +;;;; Same shape as dev-repl.flan and for the same reason — C-x C-e is a thunk +;;;; the agent runs at a frame boundary, so a program under test has to keep +;;;; reaching them — but with room to spare. What test_dev.ml drives here is +;;;; the *failing* path, and a failure in this loop costs a clang driver that a +;;;; success does not: the macro module is built from scratch, thrown away, and +;;;; built again. dev-repl.flan's 4000 frames are twenty seconds, which is less +;;;; than that sequence takes on a cold cache, and a program that ran out mid +;;;; test would look exactly like the session death the test is here to deny. +;;;; +;;;; Two minutes, then, against a block that runs in well under one: enough +;;;; margin for a cold machine, and short enough that an aborted run does not +;;;; leave a process of this behind for the rest of the afternoon. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn step [] i64 + (set ticks (+ ticks 1)) + ticks) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-robust-fallback.sock") + (dotimes [i 24000] + (agent/wait 5) + (set ticks (step))) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index d81d604..6b62062 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2802,6 +2802,233 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ nsock; nlog ]; + (* ── A build that fails is a refusal, not the end of the session ── *) + + (* Evaluating runs a compiler, and a compiler can fail in ways the + frontend never does. Expansion is part of both C-c C-c and C-x C-e now, + and expanding means building a macro module and dlopening it — a whole + clang driver, which answers with an exit status and a [Failure], not + with a [Loc.Error]. The daemon used to catch only the latter, at each + op, so the former went past [serve] and took the session with it: the + program stays on screen, the daemon is gone, and the editor finds out + at its next request, on a closed socket. NEXT.md's rule — a form that + does not check leaves the session exactly as it was — is about every + way a form can be refused, not only the checker's. + + The build is made to fail by taking the cache directory away from it, + which is the one lever that reaches the macro module and nothing else: + a redefinition module goes llc-then-ld into the daemon's own working + directory and does not touch the cache, so an ordinary evaluation is + unaffected while this is in force. It is also the failure *shape* that + matters here rather than its cause — the daemon cannot tell a linker + that cannot write its output from a macro body clang rejects, and the + claim is about what it does with either. + + Its own daemon, its own program and its own cache: the cache has to + start empty for the first expansion to be a miss, and the program has to + outlive a sequence with several cold clang drivers in it, which is what + programs/dev-robust.flan is for. *) + let rsock = tmp "robust.sock" and rout = tmp "robust.out" in + let rcache = tmp "robust.cache" in + let rec rm_rf path = + match Sys.is_directory path with + | true -> + Array.iter (fun f -> rm_rf (Filename.concat path f)) (Sys.readdir path); + (try Sys.rmdir path with Sys_error _ -> ()) + | false -> (try Sys.remove path with Sys_error _ -> ()) + | exception Sys_error _ -> () + in + (* A run that failed half way through leaves it read-only, and a second + [dune test] has to start from the same place as the first. *) + (try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ()); + rm_rf rcache; + (try Sys.remove rsock with Sys_error _ -> ()); + Unix.mkdir rcache 0o700; + let renv = + Array.of_list + (List.filter + (fun kv -> + not (String.length kv >= 15 && String.sub kv 0 15 = "FLAN_CACHE_DIR=")) + (Array.to_list (Unix.environment ())) + @ [ "FLAN_CACHE_DIR=" ^ rcache ]) + in + let rfd = Unix.openfile rout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let rpid = + Unix.create_process_env flan + [| flan; "dev"; "programs/dev-robust.flan"; "-s"; rsock |] + renv Unix.stdin rfd Unix.stderr + in + Unix.close rfd; + if not (listening ~pid:rpid rsock) then begin + fail "the robustness daemon %s" !listen_why; + (try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect rsock in + let ask sexp = + (* Its own buffer: the transcript checks above are about other + programs, and this one's output is nobody's evidence. *) + Wire.parse (Wire.send c sexp; Wire.recv c) + in + (* A reply that never arrived is the failure being denied, and it comes + back as an exception out of [Wire.recv] rather than as a status — so + every step here is prepared to say "the session died" by name instead + of ending the test binary on an unhandled [Wire.Closed]. *) + let ask_or what sexp = + match ask sexp with + | r -> Some r + | exception e -> + fail "%s ended the session: %s" what (Printexc.to_string e); + None + in + let message r = + match Wire.string_field r "message" with Some m -> m | None -> "" + in + (* What the session knows, as the editor can see it. Liveness is not the + property — a daemon that answers while having lost track of the + program is worse than one that died — so the failing steps below are + bracketed by this and it has to come back unchanged. *) + let knows () = + match ask_or "describe" "(:op \"describe\")" with + | Some r -> + (match Wire.field r "fns" with + | Some f -> Form.to_string f + | None -> "") + | None -> "" + in + (* An origin inside the programs directory, because an [import] is + resolved relative to the file the form came from and the package is + beside it. The file itself need not exist: it is an editor buffer. *) + let origin = Filename.concat (Sys.getcwd ()) "programs/buf.flan" in + (* The package's macros have to be in the session before C-x C-e can + reach an expansion at all — an evaluated import is how they get + there, which is [Session.eval]'s macro union. *) + (match + ask_or "the import" + (Printf.sprintf + "(:op \"eval\" :code \"(import mac \\\"pkgs/mac\\\")\" :file %s)" + (Wire.quote origin)) + with + | Some r when status r = "ok" -> () + | Some r -> fail "importing a macro package: %s %s" (status r) (message r) + | None -> ()); + + (* ── C-x C-e, the path that newly reaches the driver ───────────── *) + (* Taken after the import, which is a change that was *accepted*: the + baseline is what the session knows when the failing step begins. *) + let before = knows () in + (try Unix.chmod rcache 0o500 with Unix.Unix_error _ -> ()); + (match + ask_or "an expression whose macro module will not build" + (Printf.sprintf + "(:op \"eval-expr\" :code \"(mac/quad 4)\" :file %s)" + (Wire.quote origin)) + with + | Some r -> + if status r <> "error" then + fail "an expression whose macro module will not build answered %s" + (status r); + (* The compiler's own words, which is the whole of what an editor has + to go on. "internal error" would be a reply nobody can act on. *) + if not (contains_sub (message r) "(exit ") then + fail "the reply did not carry the compiler's message: %S" + (message r) + | None -> ()); + if knows () <> before then + fail "a failed expression changed what the session knows:\n \ + was: %s\n now: %s" before (knows ()); + (try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ()); + (* Usable afterwards, and usable *for the thing that just failed*: the + same expression, expanded by the module that would not build a moment + ago. A session that had kept a half-built anything would fail here. *) + (match + ask_or "the expression after a failed one" + (Printf.sprintf + "(:op \"eval-expr\" :code \"(mac/quad 4)\" :file %s)" + (Wire.quote origin)) + with + | Some r when status r = "ok" -> + (match Wire.string_field r "value" with + | Some "16" -> () + | Some v -> fail "(mac/quad 4) evaluated to %s, not 16" v + | None -> fail "the expression after a failed one produced no value") + | Some r -> + fail "the expression after a failed one: %s %s" (status r) (message r) + | None -> ()); + + (* ── C-c C-c, which is a different path and was as exposed ─────── *) + + (* A [defmacro] in the form being evaluated, so this evaluation's macro + set is one the cache has never seen and the build is a miss again. It + is also the case NEXT.md describes literally: a macro whose module + does not build. *) + let macro_defn = + "(defmacro plusone [args] `(+ ~(at args 0) 1)) \ + (defn probe-one [] i64 (plusone 41))" + in + let before = knows () in + (try Unix.chmod rcache 0o500 with Unix.Unix_error _ -> ()); + (match + ask_or "a defmacro whose module will not build" + (Printf.sprintf "(:op \"eval\" :code %s :file %s)" + (Wire.quote macro_defn) (Wire.quote origin)) + with + | Some r -> + if status r <> "error" then + fail "a defmacro whose module will not build answered %s" (status r); + if not (contains_sub (message r) "(exit ") then + fail "the reply did not carry the compiler's message: %S" + (message r) + | None -> ()); + (* Nothing of the refused form is in the session — not the macro, and + not the function that was declared beside it. *) + (match knows () with + | k when k <> before -> + fail "a failed redefinition changed what the session knows:\n \ + was: %s\n now: %s" before k + | k -> if contains_sub k "probe-one" then + fail "a refused redefinition left probe-one in the session"); + (try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ()); + (match + ask_or "the redefinition after a failed one" + (Printf.sprintf "(:op \"eval\" :code %s :file %s)" + (Wire.quote macro_defn) (Wire.quote origin)) + with + | Some r when status r = "ok" -> () + | Some r -> + fail "the redefinition after a failed one: %s %s" (status r) + (message r) + | None -> ()); + (* And the session knows it *now*, which is the half of "usable + afterwards" that a live socket does not show: the name is there, and + calling it runs the body the failed evaluation never installed. *) + if not (contains_sub (knows ()) "probe-one") then + fail "the redefinition after a failed one installed nothing"; + (match + ask_or "a call to the function the recovered evaluation installed" + (Printf.sprintf "(:op \"eval-expr\" :code \"(probe-one)\" :file %s)" + (Wire.quote origin)) + with + | Some r when status r = "ok" -> + (match Wire.string_field r "value" with + | Some "42" -> () + | Some v -> fail "(probe-one) evaluated to %s, not 42" v + | None -> fail "(probe-one) produced no value") + | Some r -> fail "(probe-one): %s %s" (status r) (message r) + | None -> ()); + (try + ignore (Wire.send c "(:op \"close\")"); + ignore (Wire.recv c) + with _ -> ()); + (try Unix.close c with Unix.Unix_error _ -> ()) + end; + (try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] rpid) with Unix.Unix_error _ -> ()); + (try Unix.chmod rcache 0o700 with Unix.Unix_error _ -> ()); + rm_rf rcache; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ rsock; rout ]; + 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" diff --git a/test/test_session.ml b/test/test_session.ml index 486a526..f9aad25 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -130,6 +130,65 @@ let () = | c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover" | exception Loc.Error { Loc.dmsg = m; _ } -> fail "the session was poisoned by a typo: %s" m); + (* "Exactly as it was" is about every field the session holds, not only the + declarations, and the imported macro set is the one that used to be + written before the checker ran rather than after it. A refused form that + brought an import with it would have left the session holding the + package's macros while holding none of its declarations — accepting half + of a change it reported as refused, which is the state a daemon that + answers and has lost track of the program is made of. + + Asserted from the other side, because the set itself is private: after the + refusal, a form that calls the package's macro has to be an unknown name. + If the macros had been kept, this would instead build a macro module and + expand — and the expansion would name [mac/twice], which the session has + no declaration for. *) + (let mt, _ = Session.create ~file:"programs/reload.flan" () in + (match Session.eval mt "(import mac \"pkgs/mac\") (defn bump [] i64 nonsense)" with + | _ -> fail "an import beside an unresolvable name was accepted" + | exception Loc.Error _ -> ()); + match Session.eval mt "(defn bump [] i64 (mac/twice 3))" with + | _ -> + fail "a refused evaluation left the session holding the import's macros" + | exception Loc.Error { Loc.dmsg = m; _ } -> + (* By name, so that this cannot pass on some other refusal: what is being + asserted is that [mac/twice] never became a name here. *) + if not (has m "mac/twice") then + fail "the refusal after a rolled-back import was about something \ + else: %S" m); + + (* And the same question asked of [eval_expr], which keeps state of its own: + a copy of a generic it instantiated stays in the session's program, + because the module that carries it is about to be built and loaded. A + refusal must add nothing — the session would otherwise believe it holds a + body no module was ever written for, and would not emit it again. + + What this reaches is the refusal every REPL meets, which is the checker's, + and the checker's is *before* any copy is generated. The window after one + is generated is closed by where the assignment sits — below [Emit], the + last thing in [eval_expr] that can raise — and not by anything here: an + [Emit] that raised would be a compiler bug, and there is no way to ask for + one from out here. What is left uncovered by both is [Check.expression]'s + own mutation: the copy is recorded in the env whether or not the rest + succeeds, and nothing rolls that back. *) + (let xt, _ = Session.create ~file:"programs/reload-generic.flan" () in + let count () = List.length xt.Session.program.Tast.fns in + let before = count () in + (match Session.eval_expr xt "(pick (slice [1.5 0.5] 0 2) nonsense)" with + | _ -> fail "a bad expression was accepted" + | exception Loc.Error _ -> ()); + if count () <> before then + fail "a refused expression left %d functions in the session, not %d" + (count ()) before; + (* Still usable, and still able to generate the copy the refused one did + not: the recovery half of the same claim. *) + match Session.eval_expr xt "(println (pick (slice [1.5 0.5] 0 2)))" with + | e -> + if not (has e.Session.ir "pick-f64") then + fail "the expression after a refused one carried no copy" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "the session was poisoned by a bad expression: %s" m); + (* A declaration the program already has, with no body and no new storage, is accepted and has nothing to send. Building a module for it would report success for a change that cannot have taken effect, and would cost the