From f2be0a62dd626d5c5ce09dd940ee6c407b27b7c2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 13:07:25 +0700 Subject: [PATCH] A pause is waited for by name, and a build is not a socket MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- BUILT.md | 8 ++++ NEXT.md | 12 ++++-- lib/dev.ml | 17 +++++++- test/programs/dev-pause.flan | 12 ++++++ test/test_dev.ml | 82 ++++++++++++++++++++++++++++++------ test/test_emacs.ml | 7 ++- test/test_repl.ml | 8 +++- 7 files changed, 126 insertions(+), 20 deletions(-) diff --git a/BUILT.md b/BUILT.md index fa3a513..421fd9d 100644 --- a/BUILT.md +++ b/BUILT.md @@ -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 diff --git a/NEXT.md b/NEXT.md index de90b07..20d9cc2 100644 --- a/NEXT.md +++ b/NEXT.md @@ -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 diff --git a/lib/dev.ml b/lib/dev.ml index 2ae1c31..04db953 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 diff --git a/test/programs/dev-pause.flan b/test/programs/dev-pause.flan index 9f5afb0..901836f 100644 --- a/test/programs/dev-pause.flan +++ b/test/programs/dev-pause.flan @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index b184eac..32fff3e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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:"" (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 diff --git a/test/test_emacs.ml b/test/test_emacs.ml index b2ffdc0..25ffdcf 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -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 diff --git a/test/test_repl.ml b/test/test_repl.ml index f642277..5e0a1d5 100644 --- a/test/test_repl.ml +++ b/test/test_repl.ml @@ -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 =