The session is put back however the module failed to land

The three named arms are not every way a step after the check can fail.
write_file makes the daemon's copy of the module's text before llc is called at
all, and a Sys_error from it went out through serve's guard with the session
already holding the declaration — the same stranded declaration under a
different exception. Dev.eval now restores on the way past anything that
escapes, and carries an accepted flag so that a module the agent has already
taken is never rolled back out from under the process.

That is also the seam the crash can be reproduced through. test_dev takes the
daemon's working directory away from it — its own, not the macro cache the two
failures above use, which cannot fail a build with no macro in it — evaluates a
defn, and then calls it. Without the restore the daemon lists probe-two in
describe and the call closes the socket: the null cell, the game thread, and
address 0.
This commit is contained in:
Joseph Ferano 2026-09-18 07:42:41 +07:00
parent d36c77ba6b
commit b23dcf73f3
2 changed files with 105 additions and 0 deletions

View File

@ -603,6 +603,23 @@ let eval t ~code ~origin ~pause =
[ ":names " ^ Wire.strings c.Session.names; ":fns ()";
":note " ^ Wire.quote "nothing to install" ]
| c ->
(* Everything from here to the delivery is inside the restore, and by
exception type as well as by arm. The three named below are the ones
with a sentence to say; what is left is every other way a file system
can refuse [write_file] cannot create its copy of the module's text,
the working directory went away underneath the daemon which used to
leave through [serve]'s guard with the session already holding the
declaration. That is the same stranding under a different exception,
and [serve] still writes the reply: this only puts the session back on
the way past.
[accepted] is what the catch-all needs to know and the arms cannot
tell it. Once the agent has said "ok" the module is the program's,
whatever goes wrong while this reply is being written, and rolling
the session back then would strand the declaration the other way
round the process holding a body the session has forgotten. *)
let accepted = ref false in
(try
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "m%d.so" t.n) in
(* [Build.shared] deletes its own .ll unless asked to keep it, and what it
@ -619,6 +636,7 @@ let eval t ~code ~origin ~pause =
| timing ->
(match deliver t out with
| "ok" ->
accepted := true;
t.gen <- t.gen + 1;
List.iter
(fun n ->
@ -647,6 +665,7 @@ let eval t ~code ~origin ~pause =
("cannot reach the program on " ^ t.agent ^ ": "
^ Unix.error_message e))
| exception Failure m -> refused m)
with e when not !accepted -> Session.restore t.session before; raise e)
(* Nothing to put back: the check itself raised, so [Session.eval] never
reached its assignments. The restore is written anyway rather than
reasoned about at each arm a refusal that costs one record copy is

View File

@ -3215,6 +3215,92 @@ let () =
| None -> fail "(probe-one) produced no value")
| Some r -> fail "(probe-one): %s %s" (status r) (message r)
| None -> ());
(* ── A form that checks and then fails to land ─────────────────── *)
(* The two above fail inside the check — a macro module that will not
build is refused before [Session.eval] has committed anything, which
is the easy half. This is the other half, and it is the one that used
to end in a segfault: a form that checks, joins the session, and then
cannot be built or cannot be delivered. The editor reads an error and
the session goes on holding the declaration; the next module built for
that session lists the name in its install prologue, interns a cell
for it, stores nothing in it, and the first call through that cell
jumps the game thread to address 0.
Reached by taking the daemon's own working directory away from it,
which is where a redefinition module is written a different lever
from the cache above, and deliberately so: the cache is the macro
module's and cannot fail a build that has no macro in it. The
directory is named after the daemon's pid, which is the one this test
started.
The last step is the crash. Pre-fix, [(probe-two)] compiled to a call
through a null cell and this file died with the program; the assertion
it now makes is that the daemon refuses by name instead. *)
let devdir =
Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" rpid)
in
let probe_two = "(defn probe-two [] i64 7)" in
let before = knows () in
(try Unix.chmod devdir 0o500 with Unix.Unix_error _ -> ());
(match
ask_or "a redefinition the daemon cannot write its module for"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote probe_two) (Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "a redefinition whose module could not be written answered %s"
(status r)
| None -> ());
(try Unix.chmod devdir 0o700 with Unix.Unix_error _ -> ());
(match knows () with
| k when k <> before ->
fail "a redefinition that never landed changed what the session \
knows:\n was: %s\n now: %s" before k
| k ->
if contains_sub k "probe-two" then
fail "a redefinition that never landed left probe-two in the \
session");
(match
ask_or "an expression calling a redefinition that never landed"
(Printf.sprintf "(:op \"eval-expr\" :code \"(probe-two)\" :file %s)"
(Wire.quote origin))
with
| Some r ->
if status r <> "error" then
fail "an expression calling a body no module carries answered %s"
(status r);
if not (contains_sub (message r) "probe-two") then
fail "the refusal did not name the body that never landed: %S"
(message r)
| None -> ());
(* Usable afterwards, for the thing that just failed: the same form
again, and then the call that could not be made. *)
(match
ask_or "the redefinition after one that could not be written"
(Printf.sprintf "(:op \"eval\" :code %s :file %s)"
(Wire.quote probe_two) (Wire.quote origin))
with
| Some r when status r = "ok" -> ()
| Some r ->
fail "the redefinition after one that could not be written: %s %s"
(status r) (message r)
| None -> ());
(match
ask_or "a call to the body the recovered evaluation installed"
(Printf.sprintf "(:op \"eval-expr\" :code \"(probe-two)\" :file %s)"
(Wire.quote origin))
with
| Some r when status r = "ok" ->
(match Wire.string_field r "value" with
| Some "7" -> ()
| Some v -> fail "(probe-two) evaluated to %s, not 7" v
| None -> fail "(probe-two) produced no value")
| Some r -> fail "(probe-two): %s %s" (status r) (message r)
| None -> ());
(* ── An editor that leaves before its reply does ──────────────── *)
(* The failure this closes was a flake in test_emacs, and it read like
nothing it was: two break-loop checks failing, and then