From cdcdd70c4e5f9c03d8435ad69cc50193e3113853 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 14:04:50 +0700 Subject: [PATCH 1/2] The object cache outlives the run, and the await says which wait it was Build.cachedir sat under TMPDIR, which dune makes private per run, so no test run ever reused an object and every build in the suite was cold. It moves to $XDG_CACHE_HOME/flan/objcache (FLAN_CACHE_DIR overrides), which is safe because the keys are total: compile_c digests the source text, the compiler's stamp and every flag; wasm_resource_dir digests the builtins archive; compiler_object digests flan.cmxa and flan.a. Writes were already .tmp-then-rename, so concurrent dune jobs are fine. Macro.key was the one key that was not total -- prelude text plus the call's forms, and nothing about the compiler whose codegen produced the .so it names, which is dlopened straight back into this binary. Under a per-run TMPDIR that never showed; under a durable cache it is a stale expander that crashes rather than a compile error. It carries the compiler's stamp now, handed across start_merged's exec in FLAN_COMPILER_STAMP because a merged dev binary lives at a per-session path and keying on that rebuilt a macro module every dev start. Measured on dev-repl.flan, launch to bound socket: 2.0s cold against 0.48s warm. Whole-program flan build: 1.44s against 0.06s. Full dune test 25.7s/30.1s before, 24.0s after, user CPU ~50s down to ~34s. And the await: one timer covered two waits, a build then a bind, so 'the daemon never listened' was a wrong diagnosis of a build that had not finished. listening now polls the process alongside the socket and says which -- exited with a status, or still running and therefore still building. A daemon that dies fails in milliseconds instead of costing the whole timeout. Thirty seconds, down from a minute, because the build it waits on is warm now. --- BUILT.md | 4 +- NEXT.md | 56 +++++++++++++++-------- lib/build.ml | 44 ++++++++++++++++-- lib/dev.ml | 6 +++ lib/macro.ml | 29 +++++++++++- test/test_dev.ml | 111 +++++++++++++++++++++++++++++++-------------- test/test_emacs.ml | 48 +++++++++++++++++--- test/test_repl.ml | 48 +++++++++++++++++--- 8 files changed, 272 insertions(+), 74 deletions(-) diff --git a/BUILT.md b/BUILT.md index 421fd9d..d26997a 100644 --- a/BUILT.md +++ b/BUILT.md @@ -3720,7 +3720,9 @@ answered it, and neither `retry` nor `use-value` means *give up*. `web-files.fla | link | 20ms | Every C translation unit a build needs — the host shim and each package's shim — goes through `Build.compile_c`, which -compiles to a `.o` under `$TMPDIR/flan-objcache` and reuses it. The key is a digest of the source text, the compiler +compiles to a `.o` under `$XDG_CACHE_HOME/flan/objcache` (`~/.cache/flan/objcache`, or `$FLAN_CACHE_DIR`) and +reuses it. It used to sit under `$TMPDIR`, which meant dune — which gives every run a private `TMPDIR` — never reused +an object and every build in the test suite was cold. The key is a digest of the source text, the compiler (its path, size and mtime, so an upgrade invalidates without paying a `clang --version` subprocess per build), `opts.opt` and `opts.target`. The opt level has to be in there: the acceptance table builds the same programs at `-O0` and `-O2`, and an `-O2` object must not serve an `-O0` build. The object is written to a temporary name and `rename`d diff --git a/NEXT.md b/NEXT.md index b0afb1a..38445a7 100644 --- a/NEXT.md +++ b/NEXT.md @@ -101,19 +101,29 @@ 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. -**The `the daemon never listened` flake is diagnosed and fixed, and it was never a race.** 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 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 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` so the reason is -written once for its thirteen daemons. +**The `the daemon never listened` flake is closed at the root, and the root was a cold cache.** The wait is not for +a socket but for an llc-and-link of the whole program before `flan dev` binds, and that build was cold on every +invocation because `Build.cachedir` sat under `$TMPDIR` — which dune makes private per run. The cache now lives under +`$XDG_CACHE_HOME/flan/objcache` (`$FLAN_CACHE_DIR` overrides). Measured on `dev-repl.flan`, launch to bound socket: +**2.0s cold, 0.48s warm**; whole-program `flan build` **1.44s cold, 0.06s warm**; full `dune test` 25.7s/30.1s before +against 24.0s after, with user CPU down from ~50s to ~34s — the wall gain is small because the suite is bound by +sequential test steps, not by compiles. -Two things found while chasing it that are worth not re-deriving. **The site was `test_dev.ml:77`**, not -`test_emacs.ml`/`test_repl.ml` — the belief that only those two carry that wording was false and sent one lane after -the wrong file. And **every build in the suite is cold**, because `Build.cachedir` (`lib/build.ml:59`) sits under -dune's per-run `TMPDIR`, so no run ever reuses the object cache: ~550ms warm against 2.9-4.0s cold. That is the -root of the timeout problem and a longer `await` only hides it. +The move was safe because the keys are total, which is the thing to check before moving a cache and not after: +`compile_c` digests the source *text*, the compiler binary's stamp and every flag; `wasm_resource_dir` digests the +builtins archive; `compiler_object` digests flan.cmxa and flan.a. Writes are already `.tmp`-then-`rename`, so a +shared durable cache is safe under dune's own parallelism. **One key was not total**: `Macro.key` was prelude text +plus the call's forms, with nothing about the compiler that emitted the `.so` it names — and that `.so` is dlopened +back into this binary, so a codegen or ABI change served a stale expander as a crash rather than an error. It now +carries the compiler's stamp, passed across `start_merged`'s exec in `FLAN_COMPILER_STAMP` because a merged dev +binary's own path is a per-session throwaway under /tmp (keying on it rebuilt a macro module every dev start — +~350ms, most of what this cache exists to save). + +`lib/cimport.ml` spells its own copy of the old `cachedir` (line 828) and still sits under `$TMPDIR`. Another lane +holds that file; folding it onto `Build.cachedir` is a one-line change when that lane lands. + +Worth not re-deriving: **the site was `test_dev.ml:77`**, not `test_emacs.ml`/`test_repl.ml` — the belief that only +those two carry that wording was false and sent one lane after the wrong file. **The socket ordering fix is confirmed** at 30 sequential full `dune test` runs, 0 failures, no `never bound` in any log — so the section this file used to carry about it is gone. @@ -121,14 +131,20 @@ log — so the section this file used to carry about it is gone. 1. **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. -**The other "never listened" was not a race, and the note that sent people after one was wrong twice.** That wording -came from *three* sites, `test_dev.ml:77` included, not from the two this file named. And it is a bound too short for -a build, not contention: `flan dev` links the whole program before it binds, ~600ms warm and measured at 6.5-6.8s -under dune's own parallelism, against 5000ms in `test_dev.ml` and 8000ms in the other two — `Build.cachedir` lives -under dune's per-run `TMPDIR`, so that build is cold on every invocation. Fixed on another branch: the three awaits -wait a minute now, bounded by the watchdog, with a named `listening` helper in `test_dev.ml`. The one thing not to -re-derive from `HANDOFF-f1.md` is its "lengthening any timeout" bullet — that applies to the `agent.sock` check -only, and reading it as a rule is what kept this open. +**The `never listened` message named the wrong thing, and now it names which.** One timer covered two waits — a +build, then a bind — so the message was a wrong diagnosis, which costs more than no message. `listening` in +`test_dev.ml` (and the copy in `test_emacs.ml` and `test_repl.ml`) polls the daemon's process alongside the socket +and reports which of the two failed: "exited with status N before binding " when it died, "was still running +after 30s without binding , so it was the build that did not finish, not the socket" when it did not. A crash +now fails in milliseconds instead of costing the whole timeout, which is the half of "split the waits" that was +actually worth having. The timers are 30s, down from a minute, because the build they wait on is warm now. + +1. **The two waits are still one wait.** Separating them needs a signal from `flan dev` that the build is done and + the bind has begun — a sentinel beside the socket in `start_merged` and `two_process`, or the existing + `flan dev: built %s in %.0fms` stderr line captured per daemon. The stderr route means redirecting stderr at + twelve spawn sites in `test_dev.ml` and polling a log for a substring; the sentinel is two lines in `lib/dev.ml` + and an unambiguous boundary, and is the one to do if this is picked up. Neither was done here because watching + the process already buys the fail-fast, and the message already says which wait it was. ### From `HANDOFF-f3.md` — the watch is built; two tests are not diff --git a/lib/build.ml b/lib/build.ml index e208eae..986d8d4 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -52,13 +52,51 @@ let workdir () = (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); d +(* [mkdir -p]: each component in turn, [EEXIST] swallowed at each, because the + cache now lives several directories down rather than one. *) +let rec mkdir_p d = + if not (Sys.file_exists d) then begin + let parent = Filename.dirname d in + if parent <> d then mkdir_p parent; + try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> () + end + (* The object cache, which unlike [workdir] is stable across builds. The C that goes into a build — the host shim and the packages' shims — is the same on every build and never the thing being edited, yet it was being recompiled - each time: 40ms of a 140ms build for [flan_rt.c] alone. *) + each time: 40ms of a 140ms build for [flan_rt.c] alone. + + Under the *cache* directory and not under [TMPDIR], which is where it used + to be, because dune gives every test run a fresh private [TMPDIR] — so the + suite never once reused an object and every build in it was cold. Measured + on this program: [flan dev] to a bound socket in 2.0s cold against 0.48s + warm, and a whole-program [flan build] in 1.44s against 0.06s. The one + thing that made the move safe to do rather than a way to serve a stale + object is that the keys are total: [compile_c] digests the source *text*, + the compiler binary's own stamp, [opt] and every flag; [wasm_resource_dir] + digests the builtins archive it copies; [Dev.compiler_object] digests + flan.cmxa and flan.a. There is nothing an isolated directory was hiding. + (The one key that was *not* total is [Macro]'s — see the note there.) + + FLAN_CACHE_DIR overrides it, for a build that wants a cache of its own. *) let cachedir () = - let d = Filename.concat (Filename.get_temp_dir_name ()) "flan-objcache" in - (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let d = + match Sys.getenv_opt "FLAN_CACHE_DIR" with + | Some d when d <> "" -> d + | _ -> + let base = + match Sys.getenv_opt "XDG_CACHE_HOME" with + | Some d when d <> "" -> d + | _ -> + (match Sys.getenv_opt "HOME" with + | Some h when h <> "" -> Filename.concat h ".cache" + (* Neither set: back to where this used to live, because a cache + with nowhere to go must not be a build failure. *) + | _ -> Filename.get_temp_dir_name ()) + in + Filename.concat (Filename.concat base "flan") "objcache" + in + mkdir_p d; d type opts = { diff --git a/lib/dev.ml b/lib/dev.ml index 04db953..52207ba 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -2443,6 +2443,12 @@ let start_merged ?(debug = false) ~file ~sock () = Unix.putenv "FLAN_DEV_DIR" dir; Unix.putenv "FLAN_DEV_HOST_LL" host_ll; Unix.putenv "FLAN_DEV_DEBUG" (if debug then "1" else "0"); + (* Not read by the exec'd binary's dev path but by [Macro]: the merged binary + expands the prelude a second time, and the object cache's macro key is + keyed on the compiler's identity. Its own [Sys.executable_name] is this + session's throwaway under /tmp, new on every start, so without this the + macro module is rebuilt per session. See the note on [Macro.self]. *) + Unix.putenv "FLAN_COMPILER_STAMP" (Build.stamp_of Sys.executable_name); (try Unix.unlink sock with Unix.Unix_error _ -> ()); Printf.eprintf "flan dev: built %s in %.0fms\n%!" (Filename.basename file) ((Unix.gettimeofday () -. t0) *. 1000.); diff --git a/lib/macro.ml b/lib/macro.ml index de18afd..9be9912 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -51,10 +51,37 @@ type loaded = { fns : (string * Dynload.addr) list; } +(* This compiler's own identity, and it belongs in the key for a reason the + other caches do not have. A [.o] under the object cache is decided entirely + by the C text and the C compiler that made it, so its key is total without + naming flan at all. A macro module is not: it is *this* binary's codegen, + dlopen'd back into *this* binary and called across a marshalled boundary. + Change [Emit] or the runtime ABI and the .so on disk is wrong while the + prelude text that keyed it has not moved — a stale macro expander, which + fails as a crash inside [Expand.call] rather than as a compile error. + + It never showed because the cache sat under dune's per-run [TMPDIR] and so + was empty on every run. Now that the cache outlives the run, the key has to + carry what the directory used to hide. + + The stamp of the running binary is the identity, except in the one place + where that binary is not a stable thing: a [flan dev] merged build lives at + /tmp/flan-dev-/program, so its size-and-mtime is new on every start and + keying on it would rebuild a macro module per session — measured at ~350ms + of every dev start, which is most of what this cache exists to save. So + [Dev.start_merged] passes its own stamp across the exec, and the merged + binary uses the stamp of the compiler that built it, which is the one this + key is actually about. *) +let self = + lazy + (match Sys.getenv_opt "FLAN_COMPILER_STAMP" with + | Some s when s <> "" -> s + | _ -> Build.stamp_of Sys.executable_name) + let key (extra : Form.t list) = Digest.to_hex (Digest.string - (Prelude.source ^ "\000" + (Lazy.force self ^ "\000" ^ Prelude.source ^ "\000" ^ String.concat "\000" (List.map Form.to_string extra))) (* True while a macro module is being built. [Build.macro_module] goes through diff --git a/test/test_dev.ml b/test/test_dev.ml index 32fff3e..53bf694 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -23,18 +23,59 @@ 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. +(* Waiting for a daemon to listen is waiting for two different things with one + timer: [flan dev] compiles the whole program first, and only then binds. The + old message, "the daemon never listened", named the second and was almost + always the first — which is a wrong diagnosis, and a wrong diagnosis costs + more than no message at all. - 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) + So this says which. It cannot separate the two waits without a signal from + [flan dev] that the build is done (see NEXT.md), but it can separate the two + *failures*, and that is what actually gets read: a daemon still running when + the timer expires was building, and a daemon that is gone bound nothing + because it died. The second no longer costs the whole timeout either — + the poll watches the process as well as the socket, so a crash fails in + milliseconds instead of in half a minute, which is the part that makes a + suite worth trusting. + + Thirty seconds, down from a minute, because the object cache is durable now + (Build.cachedir) and the build this waits on is warm: 0.48s idle against + 2.0s cold, and the worst ever measured under dune's own parallelism was + 6.8s — cold. The watchdog at 900s is still what bounds the run. + + [!listen_why] carries the reason to the caller so each site can keep its own + name for its daemon. One ref is enough: this file is single-threaded and the + next thing after a failed wait is always the report of it. *) +let listen_why = ref "" + +let listening ?(ms = 30000) ~pid path = + let died = ref None in + ignore + (await ~ms (fun () -> + Sys.file_exists path + || + (* Reaped only once it is already gone, and only on the path that ends + in a failure, so a teardown's own [waitpid] is unaffected. *) + match Unix.waitpid [ Unix.WNOHANG ] pid with + | 0, _ -> false + | _, st -> died := Some st; true + | exception Unix.Unix_error _ -> false)); + if Sys.file_exists path then true + else begin + listen_why := + (match !died with + | Some (Unix.WEXITED n) -> + Printf.sprintf "exited with status %d before binding %s" n path + | Some (Unix.WSIGNALED n) -> + Printf.sprintf "was killed by signal %d before binding %s" n path + | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + | None -> + Printf.sprintf + "was still running after %ds without binding %s, so it was the \ + build that did not finish, not the socket" + (ms / 1000) path); + false + end let rec connect ?(ms = 5000) path = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in @@ -86,8 +127,8 @@ let () = in Unix.close fd; - if not (listening sock) then - fail "the daemon never listened" + if not (listening ~pid sock) then + fail "the daemon %s" !listen_why else begin (* The daemon owns the program's lifetime and kills it on [close], so every step waits for the program to have got there. "ok" from an eval @@ -421,8 +462,8 @@ let () = Unix.stdin bfd Unix.stderr in Unix.close bfd; - if not (listening bsock) then begin - fail "the break daemon never listened"; + if not (listening ~pid:bpid bsock) then begin + fail "the break daemon %s" !listen_why; (try Unix.kill bpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -813,8 +854,8 @@ let () = Unix.stdin xfd Unix.stderr in Unix.close xfd; - if not (listening xsock) then begin - fail "the bad-index daemon never listened"; + if not (listening ~pid:xpid xsock) then begin + fail "the bad-index daemon %s" !listen_why; (try Unix.kill xpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -941,8 +982,8 @@ let () = Unix.stdin lfd Unix.stderr in Unix.close lfd; - if not (listening lsock) then begin - fail "the locals daemon never listened"; + if not (listening ~pid:lpid lsock) then begin + fail "the locals daemon %s" !listen_why; (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1122,8 +1163,8 @@ let () = Unix.stdin ifd Unix.stderr in Unix.close ifd; - if not (listening isock) then begin - fail "the inspect daemon never listened"; + if not (listening ~pid:ipid isock) then begin + fail "the inspect daemon %s" !listen_why; (try Unix.kill ipid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1326,8 +1367,8 @@ let () = Unix.stdin gfd Unix.stderr in Unix.close gfd; - if not (listening gsock) then begin - fail "the globals daemon never listened"; + if not (listening ~pid:gpid gsock) then begin + fail "the globals daemon %s" !listen_why; (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1549,8 +1590,8 @@ let () = Unix.stdin dfd Unix.stderr in Unix.close dfd; - if not (listening dsock) then begin - fail "the disassembly daemon never listened"; + if not (listening ~pid:dpid dsock) then begin + fail "the disassembly daemon %s" !listen_why; (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1777,8 +1818,8 @@ let () = env Unix.stdin sfd Unix.stderr in Unix.close sfd; - if not (listening ssock) then begin - fail "the daemon with no working llc never listened"; + if not (listening ~pid:spid ssock) then begin + fail "the daemon with no working llc %s" !listen_why; (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1845,8 +1886,8 @@ let () = Unix.stdin gfd Unix.stderr in Unix.close gfd; - if not (listening gsock) then begin - fail "the --debug daemon never listened"; + if not (listening ~pid:gpid gsock) then begin + fail "the --debug daemon %s" !listen_why; (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -1928,8 +1969,8 @@ let () = Unix.stdin wfd Unix.stderr in Unix.close wfd; - if not (listening wsock) then - fail "the watch daemon never listened" + if not (listening ~pid:wpid wsock) then + fail "the watch daemon %s" !listen_why else begin let wc = connect wsock in let ask q = Wire.parse (Wire.send wc q; Wire.recv wc) in @@ -2099,8 +2140,8 @@ let () = Unix.stdin pfd Unix.stderr in Unix.close pfd; - if not (listening psock) then begin - fail "the pause daemon never listened"; + if not (listening ~pid:ppid psock) then begin + fail "the pause daemon %s" !listen_why; (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()) end else begin @@ -2334,8 +2375,8 @@ let () = Unix.stdin tfd Unix.stderr in Unix.close tfd; - if not (listening tsock) then - fail "--two-process never listened" + if not (listening ~pid:tpid tsock) then + fail "--two-process %s" !listen_why else begin let tc = connect tsock in let seen = Buffer.create 64 in diff --git a/test/test_emacs.ml b/test/test_emacs.ml index 25ffdcf..c5e0cda 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -20,6 +20,41 @@ let rec await ?(ms = 8000) f = else if ms <= 0 then false else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end +(* One timer covers two waits here — [flan dev] builds the whole program and + only then binds — so the failure has to say which of them it was. See + [listening] in test_dev.ml for the whole of the reasoning; this is the same + helper, kept here rather than shared because these three files have no + module between them. Watching the process as well as the socket is what + makes a crash fail in milliseconds instead of costing the full timeout. *) +let listen_why = ref "" + +let listening ?(ms = 30000) ~pid path = + let died = ref None in + ignore + (await ~ms (fun () -> + Sys.file_exists path + || + match Unix.waitpid [ Unix.WNOHANG ] pid with + | 0, _ -> false + | _, st -> died := Some st; true + | exception Unix.Unix_error _ -> false)); + if Sys.file_exists path then true + else begin + listen_why := + (match !died with + | Some (Unix.WEXITED n) -> + Printf.sprintf "exited with status %d before binding %s" n path + | Some (Unix.WSIGNALED n) -> + Printf.sprintf "was killed by signal %d before binding %s" n path + | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + | None -> + Printf.sprintf + "was still running after %ds without binding %s, so it was the \ + build that did not finish, not the socket" + (ms / 1000) path); + false + end + let () = let have cmd = Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" cmd) = 0 in if not (have "emacs") then print_endline "emacs: skipped (no emacs on PATH)" @@ -46,13 +81,12 @@ let () = Unix.stdin fd Unix.stderr in Unix.close fd; - (* 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"; + (* Thirty seconds and not the 8s default: this waits on an llc-and-link of + the whole program, ~0.5s warm and 2s cold, worst measured at 6.8s with + this suite's other binaries running beside it. The watchdog bounds the + run; a crash no longer waits for either. *) + if not (listening ~pid sock) then begin + print_endline ("FAIL the daemon " ^ !listen_why); (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ()); exit 1 end; diff --git a/test/test_repl.ml b/test/test_repl.ml index 5e0a1d5..a11b688 100644 --- a/test/test_repl.ml +++ b/test/test_repl.ml @@ -31,6 +31,41 @@ let rec await ?(ms = 8000) f = else if ms <= 0 then false else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end +(* One timer covers two waits here — [flan dev] builds the whole program and + only then binds — so the failure has to say which of them it was. See + [listening] in test_dev.ml for the whole of the reasoning; this is the same + helper, kept here rather than shared because these three files have no + module between them. Watching the process as well as the socket is what + makes a crash fail in milliseconds instead of costing the full timeout. *) +let listen_why = ref "" + +let listening ?(ms = 30000) ~pid path = + let died = ref None in + ignore + (await ~ms (fun () -> + Sys.file_exists path + || + match Unix.waitpid [ Unix.WNOHANG ] pid with + | 0, _ -> false + | _, st -> died := Some st; true + | exception Unix.Unix_error _ -> false)); + if Sys.file_exists path then true + else begin + listen_why := + (match !died with + | Some (Unix.WEXITED n) -> + Printf.sprintf "exited with status %d before binding %s" n path + | Some (Unix.WSIGNALED n) -> + Printf.sprintf "was killed by signal %d before binding %s" n path + | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + | None -> + Printf.sprintf + "was still running after %ds without binding %s, so it was the \ + build that did not finish, not the socket" + (ms / 1000) path); + false + end + let rec connect ?(ms = 8000) path = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in match Unix.connect s (Unix.ADDR_UNIX path) with @@ -68,13 +103,12 @@ let () = Unix.stdin fd Unix.stderr in Unix.close fd; - (* 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" + (* Thirty seconds and not the 8s default: this waits on an llc-and-link of + the whole program, ~0.5s warm and 2s cold, worst measured at 6.8s with + this suite's other binaries running beside it. The watchdog bounds the + run; a crash no longer waits for either. *) + if not (listening ~pid sock) then + fail "the daemon %s" !listen_why else begin let c = connect sock in let evals code = From 0a6199b8df4382c0c71c4263b0375262eddf6440 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 14:06:46 +0700 Subject: [PATCH 2/2] The failure path says which socket it was, checked by running it FLAN_CLANG=/bin/false against test_repl: 'the daemon exited with status 2 before binding /tmp/flan-repl-dev.sock' in 45ms, where the old wording would have waited out the whole timer and then blamed the socket. --- NEXT.md | 5 +++-- test/test_dev.ml | 4 +++- test/test_emacs.ml | 4 +++- test/test_repl.ml | 4 +++- 4 files changed, 12 insertions(+), 5 deletions(-) diff --git a/NEXT.md b/NEXT.md index 38445a7..f6e2750 100644 --- a/NEXT.md +++ b/NEXT.md @@ -104,8 +104,9 @@ the check took it from 2/8 failures to 0/10, and closed a second race that was b **The `the daemon never listened` flake is closed at the root, and the root was a cold cache.** The wait is not for a socket but for an llc-and-link of the whole program before `flan dev` binds, and that build was cold on every invocation because `Build.cachedir` sat under `$TMPDIR` — which dune makes private per run. The cache now lives under -`$XDG_CACHE_HOME/flan/objcache` (`$FLAN_CACHE_DIR` overrides). Measured on `dev-repl.flan`, launch to bound socket: -**2.0s cold, 0.48s warm**; whole-program `flan build` **1.44s cold, 0.06s warm**; full `dune test` 25.7s/30.1s before +`$XDG_CACHE_HOME/flan/objcache` (`$FLAN_CACHE_DIR` overrides). Measured on an idle machine, and so not comparable +with the 6.5-6.8s this file used to quote, which was a cold build under dune's own parallelism — on `dev-repl.flan`, +launch to bound socket: **2.0s cold, 0.48s warm**; whole-program `flan build` **1.44s cold, 0.06s warm**; full `dune test` 25.7s/30.1s before against 24.0s after, with user CPU down from ~50s to ~34s — the wall gain is small because the suite is bound by sequential test steps, not by compiles. diff --git a/test/test_dev.ml b/test/test_dev.ml index 53bf694..cce1cbd 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -68,7 +68,9 @@ let listening ?(ms = 30000) ~pid path = Printf.sprintf "exited with status %d before binding %s" n path | Some (Unix.WSIGNALED n) -> Printf.sprintf "was killed by signal %d before binding %s" n path - | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + (* Unreachable without WUNTRACED, and here only for exhaustiveness. *) + | Some (Unix.WSTOPPED n) -> + Printf.sprintf "stopped on signal %d without binding %s" n path | None -> Printf.sprintf "was still running after %ds without binding %s, so it was the \ diff --git a/test/test_emacs.ml b/test/test_emacs.ml index c5e0cda..9b7f378 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -46,7 +46,9 @@ let listening ?(ms = 30000) ~pid path = Printf.sprintf "exited with status %d before binding %s" n path | Some (Unix.WSIGNALED n) -> Printf.sprintf "was killed by signal %d before binding %s" n path - | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + (* Unreachable without WUNTRACED, and here only for exhaustiveness. *) + | Some (Unix.WSTOPPED n) -> + Printf.sprintf "stopped on signal %d without binding %s" n path | None -> Printf.sprintf "was still running after %ds without binding %s, so it was the \ diff --git a/test/test_repl.ml b/test/test_repl.ml index a11b688..bf607e7 100644 --- a/test/test_repl.ml +++ b/test/test_repl.ml @@ -57,7 +57,9 @@ let listening ?(ms = 30000) ~pid path = Printf.sprintf "exited with status %d before binding %s" n path | Some (Unix.WSIGNALED n) -> Printf.sprintf "was killed by signal %d before binding %s" n path - | Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n + (* Unreachable without WUNTRACED, and here only for exhaustiveness. *) + | Some (Unix.WSTOPPED n) -> + Printf.sprintf "stopped on signal %d without binding %s" n path | None -> Printf.sprintf "was still running after %ds without binding %s, so it was the \