JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A pause is waited for by name, and a build is not a socket

Browse Source 
Two follow-ups to the marking commit.

`Dev.eval_expr`'s new wait matched `Stopped _`, which fires on the first
iteration when the program is already parked on something else — the
break loop allows evaluating, so that is reachable — and answers for a
thunk that has not run yet, on a reply whose own `:condition` names the
other condition. It now waits for `Stopped "Pause"`, which the agent
reports under a nested break because `condition_name` is overwritten on
the way in and restored on the way out. `dev-pause.flan` grows a
`Missing` and a `boom` so the test can park the program on something
else first and tell the two apart.

And the flake NEXT.md had as "seen once and unexplained": `the daemon
never listened` is not a race, it is an llc-and-link of the whole
program before `flan dev` binds — ~600ms idle, measured at 6.6s and 6.8s
with the rest of the suite beside it, against a 5s and 8s await. All
three test binaries now wait a minute; the watchdog is what bounds the
run. Two consecutive full runs green.
This commit is contained in:
Joseph Ferano 2026-09-13 13:07:25 +07:00
parent 5791faee4e
commit f2be0a62dd
7 changed files with 126 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
BUILT.md
View File

@ -4941,6 +4941,14 @@ and the timeout message is the answer that path has always given — `test_dev.m
carries no `:value`, because there is not one yet; `:stopped t :condition "Pause"` rides on it the way it rides on
every reply, from `with_break`.
**And it asks for `Stopped "Pause"` by name, not for "stopped at all".** The break loop allows evaluating, so this
path is reachable from a program already parked on something else — and a match on `Stopped _` would then fire on the
first iteration, answering for a thunk that has not run yet, on a reply whose own `:condition` names the *other*
condition. Asked by name it waits through the outer break until the thunk reaches its own `(pause)`, which the agent
reports because a nested break overwrites `condition_name` and restores it on the way out (`flan_agent.c`, around the
`status` verb). A program already parked on a `Pause` is the one case this cannot tell apart, and nothing could: both
answers are "stopped at a pause".
**The editor's column is a byte offset.** `flan-dev--wire-position` is the inverse of `flan-dev--position` and has to
count bytes for the same reason: the reader walks the source a byte at a time, so `current-column` would be short by
one per extra byte in every non-ASCII character earlier on the line and the daemon would find nothing where it was

12
NEXT.md
View File

@ -24,10 +24,14 @@ The fix is ordering, not timing: the test checked for `agent.sock` before comple
the check took it from 2/8 failures to 0/10, and closed a second race that was burning the full 10s timeout.
`lib/dev.ml` was not touched.
1. **A different flake, seen once and unexplained.** `the daemon never listened` — that exact wording comes from
`test_emacs.ml:50` and `test_repl.ml:71`, not from the block that was fixed, whose other daemons all use
qualified wording. Probably the same class of bug, a bounded `await` on a socket path under parallel-dune CPU
contention, but that is a hypothesis. Loop `dune test` capturing per-binary output to pin it down.
1. ~~**A different flake, seen once and unexplained.** `the daemon never listened`~~ **Diagnosed and fixed.** The
hypothesis was right and it is not a race at all: the wait is not for a socket but for an llc-and-link of the
whole program before `flan dev` binds. That is ~600ms idle and was measured twice at **6.6s and 6.8s** with the
rest of the suite running beside it under dune's own parallelism, against a 5s (`test_dev.ml`) and 8s
(`test_emacs.ml`, `test_repl.ml`) `await`. The message reads like a bug in the daemon and is a build slower than
the timeout. All three now wait a minute — the watchdog is what bounds the run, and this only has to be long
enough that a failure means the daemon is not coming. `test_dev.ml` has a named `listening` for it so the reason
is written once for its thirteen daemons.
2. **Decide whether `merged_serve`'s 10s warning path deserves a test.** `lib/dev.ml:2322-2326` is exercised by
nothing now that the unlink race is closed.
3. **Confirm at a longer sweep if 0/10 is too thin, then delete this file's "One flaky test, measured rather than

17
lib/dev.ml
View File

@ -502,9 +502,22 @@ let eval_expr t ~code ~origin ~pause =
The [Stopped] question is asked only when a pause was requested.
Without one, a thunk that stops did so by erroring, and the
timeout message is the answer that path has always given —
which [test_dev.ml] pins. *)
which [test_dev.ml] pins.
And it asks for [Pause] by name, not for "stopped at all". The
break loop allows evaluating, so this is reachable from a
program already parked on something else — and [Stopped _] would
then answer for a thunk that has not run yet, on a reply whose
own [:condition] says the other condition's name. Asked by name
it waits through the outer break until the thunk reaches its own
[(pause)], which the agent reports because a nested break
overwrites [condition_name] and restores it on the way out.
A program already parked on a [Pause] is the one case this
cannot tell apart, and nothing could: both answers are "stopped
at a pause". *)
let stopped () =
pause && (match state t with Stopped _ -> true | _ -> false)
pause && (match state t with Stopped "Pause" -> true | _ -> false)
in
let rec wait ms =
match result t with

12
test/programs/dev-pause.flan
View File

@ -12,6 +12,18 @@
(defvar ticks i64)
;;; Something to stop on that is *not* a breakpoint, so that a marked
;;; expression sent to an already-stopped program can be told from the break it
;;; was already sitting in. It is here rather than in an evaluated form for the
;;; reason dev-loop.flan gives: the break loop matches on a class the host was
;;; compiled with.
(defstruct Missing [id i32])
(defn boom [] i64
(restart-case
(do (error (Missing {.id 1})) 0)
(carry-on [] -1)))
(defn step [] i64
(set ticks (+ ticks 1))
ticks)

82
test/test_dev.ml
View File

@ -23,6 +23,19 @@ let rec await ?(ms = 5000) f =
else if ms <= 0 then false
else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end
(* Waiting for a daemon to listen is not waiting for a socket: [flan dev]
compiles the whole program first, and only then binds. The build is llc and
a link, which is ~600ms on an idle machine and has been measured at 6.8s
with this suite's other binaries running beside it under dune's own
parallelism — so the 5s default turned a busy machine into "the daemon never
listened", a message that reads like a bug in the daemon and is not one.
A minute is not a guess about how slow the build can get; it is long enough
that a failure here means the daemon is not coming, which is the only thing
this check is trying to find out. The watchdog is the thing that bounds the
run, and it is armed at 900s for exactly this reason. *)
let listening path = await ~ms:60000 (fun () -> Sys.file_exists path)
let rec connect ?(ms = 5000) path =
let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
match Unix.connect s (Unix.ADDR_UNIX path) with
@ -73,7 +86,7 @@ let () =
in
Unix.close fd;
if not (await (fun () -> Sys.file_exists sock)) then
if not (listening sock) then
fail "the daemon never listened"
else begin
(* The daemon owns the program's lifetime and kills it on [close], so
@ -408,7 +421,7 @@ let () =
Unix.stdin bfd Unix.stderr
in
Unix.close bfd;
if not (await (fun () -> Sys.file_exists bsock)) then begin
if not (listening bsock) then begin
fail "the break daemon never listened";
(try Unix.kill bpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -800,7 +813,7 @@ let () =
Unix.stdin xfd Unix.stderr
in
Unix.close xfd;
if not (await (fun () -> Sys.file_exists xsock)) then begin
if not (listening xsock) then begin
fail "the bad-index daemon never listened";
(try Unix.kill xpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -928,7 +941,7 @@ let () =
Unix.stdin lfd Unix.stderr
in
Unix.close lfd;
if not (await (fun () -> Sys.file_exists lsock)) then begin
if not (listening lsock) then begin
fail "the locals daemon never listened";
(try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1109,7 +1122,7 @@ let () =
Unix.stdin ifd Unix.stderr
in
Unix.close ifd;
if not (await (fun () -> Sys.file_exists isock)) then begin
if not (listening isock) then begin
fail "the inspect daemon never listened";
(try Unix.kill ipid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1313,7 +1326,7 @@ let () =
Unix.stdin gfd Unix.stderr
in
Unix.close gfd;
if not (await (fun () -> Sys.file_exists gsock)) then begin
if not (listening gsock) then begin
fail "the globals daemon never listened";
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1536,7 +1549,7 @@ let () =
Unix.stdin dfd Unix.stderr
in
Unix.close dfd;
if not (await (fun () -> Sys.file_exists dsock)) then begin
if not (listening dsock) then begin
fail "the disassembly daemon never listened";
(try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1764,7 +1777,7 @@ let () =
env Unix.stdin sfd Unix.stderr
in
Unix.close sfd;
if not (await (fun () -> Sys.file_exists ssock)) then begin
if not (listening ssock) then begin
fail "the daemon with no working llc never listened";
(try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1832,7 +1845,7 @@ let () =
Unix.stdin gfd Unix.stderr
in
Unix.close gfd;
if not (await (fun () -> Sys.file_exists gsock)) then begin
if not (listening gsock) then begin
fail "the --debug daemon never listened";
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -1915,7 +1928,7 @@ let () =
Unix.stdin wfd Unix.stderr
in
Unix.close wfd;
if not (await (fun () -> Sys.file_exists wsock)) then
if not (listening wsock) then
fail "the watch daemon never listened"
else begin
let wc = connect wsock in
@ -2086,7 +2099,7 @@ let () =
Unix.stdin pfd Unix.stderr
in
Unix.close pfd;
if not (await (fun () -> Sys.file_exists psock)) then begin
if not (listening psock) then begin
fail "the pause daemon never listened";
(try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ())
end
@ -2249,6 +2262,51 @@ let () =
fail "an ordinary expression after a paused one: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"))
end;
(* And the same key on a program that is *already* stopped, which the
break loop allows. The wait has to be looking for a [Pause] and not
for "stopped at all": the outer break is already there when the
request arrives, so anything less specific would answer for a thunk
that has not run yet — and answer it on a reply whose own
[:condition] names the other condition. *)
let r =
ask "(:op \"eval-expr\" :code \"(i64 (boom))\" :file \"/tmp/buf.flan\")"
in
if status r <> "error" then
fail "an expression that erred inside a thunk answered anyway";
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the program never stopped on the expression that errs"
else begin
let r =
ask
"(:op \"eval-expr\" :code \"(+ 5 5)\" :file \"/tmp/buf.flan\" :pause t)"
in
if Wire.string_field r "condition" <> Some "Pause" then
fail
"C-u C-x C-e on an already-stopped program answered for %s, not Pause"
(Option.value ~default:"<none>" (Wire.string_field r "condition"));
if Wire.string_field r "value" <> None then
fail "C-u C-x C-e under an outer break answered with a value";
(* Innermost first, so this is the thunk's own [continue] and not
anything the outer break offers. *)
let r = ask "(:op \"restart\" :name \"continue\")" in
if status r <> "ok" then
fail "continue at a breakpoint under an outer break: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
(* Back on the outer break, which was never resumed, and out of it the
ordinary way. *)
if not
(await (fun () ->
Wire.string_field (ask "(:op \"describe\")") "condition"
= Some "Missing"))
then fail "the outer break did not come back after the inner pause";
let r = ask "(:op \"restart\" :name \"carry-on\")" in
if status r <> "ok" then
fail "resuming the outer break: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "the program never resumed from the outer break"
end;
ignore (ask "(:op \"close\")");
Unix.close c
end;
@ -2276,7 +2334,7 @@ let () =
Unix.stdin tfd Unix.stderr
in
Unix.close tfd;
if not (await (fun () -> Sys.file_exists tsock)) then
if not (listening tsock) then
fail "--two-process never listened"
else begin
let tc = connect tsock in

7
test/test_emacs.ml
View File

@ -46,7 +46,12 @@ let () =
Unix.stdin fd Unix.stderr
in
Unix.close fd;
if not (await (fun () -> Sys.file_exists sock)) then begin
(* A minute, not the 8s default: what is being waited for is not a socket
but an llc-and-link of the whole program, which has been measured at
6.8s with this suite's other binaries running beside it under dune's own
parallelism. It only has to be long enough that a failure here means the
daemon is not coming; the watchdog is what bounds the run. *)
if not (await ~ms:60000 (fun () -> Sys.file_exists sock)) then begin
print_endline "FAIL the daemon never listened";
(try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
exit 1

8
test/test_repl.ml
View File

@ -68,7 +68,13 @@ let () =
Unix.stdin fd Unix.stderr
in
Unix.close fd;
if not (await (fun () -> Sys.file_exists sock)) then fail "the daemon never listened"
(* A minute, not the 8s default: what is being waited for is not a socket
but an llc-and-link of the whole program, which has been measured at
6.8s with this suite's other binaries running beside it under dune's own
parallelism. It only has to be long enough that a failure here means the
daemon is not coming; the watchdog is what bounds the run. *)
if not (await ~ms:60000 (fun () -> Sys.file_exists sock)) then
fail "the daemon never listened"
else begin
let c = connect sock in
let evals code =