The test directory had been copying its own plumbing, file by file

Ten test binaries share a directory and had shared nothing in it but
watchdog.ml. Everything else each one needed it wrote out again: the
failure counter and its FAIL line, the three-line report tail, a poll,
a socket connect, the wait for a [flan dev] daemon to bind, a substring
search, and the Load -> Check -> Reach.link front half of a compile.

[listening] was the clearest case. Three copies, byte for byte apart
from one comment, and two of them said in that comment that they were
kept separate because "these three files have no module between them".
That was not true when it was written: watchdog.ml was already named in
the same (modules ...) stanzas. test_support.ml is the second such
module, wired the same way, and those two sentences go with the copies
they were explaining.

test_repl.ml's [quote] was Wire.quote character for character, in a file
that already links Wire and already names Wire.quote in a comment about
what the case below it is checking. It is Wire.quote now.

One real behaviour change, and it is a fix. [connect] existed twice over
with different retries: the agent's narrowed to ECONNREFUSED with a
comment saying why -- the socket file appears at bind, a moment before
listen -- while dev's and repl's retried any Unix_error, which meant an
ENOENT or an EACCES was retried to the full timeout before raising
something the reader still had to interpret. The shared one takes the
narrow version. Every caller connects to a socket [listening] has
already seen on disk, so the race it does catch is the only one left.

The rest is left where it is, on purpose. The three output-capturing
[run]s differ in what they wrap -- a pid suffix, a sanitizer environment,
a valgrind invocation -- and are not the same function. The report tails
in test_repl, test_web and the two sweep binaries print different things
for different reasons. The per-file scratch prefixes are the feature that
keeps two suites running at once from unlinking each other's sockets, so
the shared helper takes the prefix rather than choosing one. And the
[match Sys.command "command -v clang ..."] probes stay as they are:
their skip lines are output this suite pins.

bin/main.ml has the compile pipeline written out twice more. Left alone
-- this was a test/-scoped change and bin/ should not be reaching into a
test module -- and noted in FIX.org as what it actually needs, which is
the pipeline moving into lib/.

dune test: exit 0, and its output is the same line for line once the
temp-directory hash and the millisecond counts are normalised.

FIX.org

@@ -806,3 +806,16 @@ script already has SURVEY_FLAGS, which hands the same extra flags to both
 sides, and both sides do accept -O0 — and something that walks the two prim
 match arms mechanically rather than relying on somebody reading them side by
 side, which is how this gap survived. Neither is queued.
+
+** bin/main.ml still spells the compile pipeline out by hand
+The test directory's copies of Load → Check → Reach.link now go through
+[Test_support.linked] (test/test_support.ml). bin/main.ml has the same shape
+twice more — :684 and :864, each a load, a check and a [Reach.link] feeding
+[Build.executable] — and they were left alone, because the lane that did this
+was test/-scoped and because they are not quite the same three calls: the CLI
+loads through its own [load] and checks with [Check.program_all] rather than
+[Check.program]. So closing this is not a matter of calling the test module
+from bin/, which would be backwards anyway; it means the pipeline moving into
+lib/ — Build, or a small front-end module beside it — with the two checkers'
+difference made an argument, and bin/ and test_support.ml both calling that.
+Not queued.

test/dune

@@ -3,9 +3,13 @@
  ; Explicit because test_sanitize lives in this directory and is not one of
  ; these: two stanzas in one directory have to say which modules are whose.
  ; watchdog is every binary's clock: a hanging test reports nothing, so each
- ; of these arms an alarm that turns "for ever" into a failing run.
+ ; of these arms an alarm that turns "for ever" into a failing run. test_support
+ ; is the other shared module: the failure counter, the report tail, the poll,
+ ; the daemon wait and the front half of a compile, which the binaries that
+ ; wanted them had each been carrying their own copy of.
  (modules test_flan test_acceptance test_reload test_agent test_session
-          test_dev test_emacs test_repl test_cider test_dyn watchdog)
+          test_dev test_emacs test_repl test_cider test_dyn watchdog
+          test_support)
  (libraries flan unix)
  ; The acceptance programs are part of the test corpus: if the reader, the
  ; parser or the checker regresses on them we want to know here, not at the CLI.
@@ -100,7 +104,7 @@
 ; skips with the reason, so it is green on a machine that has neither.
 (test
  (name test_web)
- (modules test_web)
+ (modules test_web test_support)
  (libraries flan unix)
  (deps
   (glob_files programs/*.flan)
@@ -131,7 +135,7 @@
 ; is the whole point here.
 (executable
  (name test_sanitize)
- (modules test_sanitize watchdog)
+ (modules test_sanitize watchdog test_support)
  (libraries flan unix))
 
 (rule
@@ -177,7 +181,7 @@
 ; all. NEXT.md asked for exactly this.
 (executable
  (name test_valgrind)
- (modules test_valgrind watchdog)
+ (modules test_valgrind watchdog test_support)
  (libraries flan unix str))
 
 (rule

test/test_acceptance.ml

@@ -10,7 +10,7 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:1200 "test_acceptance"
 
-let failures = ref 0
+let failures = Test_support.failures
 
 (* The tail of this file already exits 1 when [failures] is nonzero, and
    there is no path through this binary that skips it: it is one match on
@@ -40,7 +40,7 @@ let () =
   at_exit (fun () ->
     if !failures > 0 then begin flush_all (); Unix._exit 1 end)
 
-let scratch = Filename.get_temp_dir_name ()
+let scratch = Test_support.scratch
 
 (* Every temporary path below carries the calling process's own pid. Within
    one process that is a constant, so it changes nothing about the existing
@@ -76,23 +76,16 @@ let compile ?(opt = "-O2") ?(checks = true) ?(dev = false) ?(x86 = false) path =
             program are two files and not one built twice over the other. *)
          (if x86 then "-x86" else ""))
   in
-  (* Through [Load], so a program with an (import ...) is buildable here: it
+  (* [Test_support.linked] is the read, the load, the check and the link —
-     brings back the package's C shim and linker arguments as well. *)
+     through [Load], so a program with an (import ...) is buildable here, and
-  let l = Load.program ~file:path (Reader.read_file path) in
+     through [Reach.link], so a package nothing reachable calls into hands
-  let p = Check.program l.Load.decls in
+     over no C and no linker argument. *)
-  (* [Reach.link] decides the link from the program: a package nothing
+  let p, csrcs, lflags = Test_support.linked ~dev path in
-     reachable calls into hands over no C and no linker argument, and its
-     functions are not emitted. *)
-  let p, csrcs, lflags = Reach.link ~dev l p in
   ignore (Build.executable ~opts:{ Build.default with opt; checks; dev; x86 }
             ~csrcs ~lflags p ~out:exe);
   exe
 
-(* No Str, and the reader is hand-written for the same reason. *)
+let contains = Test_support.contains
-let contains hay needle =
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  go 0
 
 (* The pool that makes this binary's wall clock survivable. Almost all of the
    112 clang invocations below are independent of one another — different
@@ -2660,9 +2653,7 @@ let () =
       else None
     in
     let wasm_build ?(opt = "-O2") path out =
-      let l = Load.program ~file:path (Reader.read_file path) in
+      let p, csrcs, lflags = Test_support.linked path in
-      let p = Check.program l.Load.decls in
-      let p, csrcs, lflags = Reach.link l p in
       ignore
         (Build.executable
            ~opts:{ Build.default with opt; target = Some "wasm32-wasi" }
@@ -5139,9 +5130,5 @@ level "1"
        been drained, in the order they were submitted in. *)
     Pool.drain_all ();
 
-    if !failures = 0 then print_endline "acceptance: all tests passed"
+    Test_support.report ~label:"acceptance" ()
-    else begin
-      Printf.printf "\n%d failure(s)\n" !failures;
-      exit 1
-    end
   | _ -> print_endline "acceptance: skipped (no clang on PATH)"

test/test_agent.ml

@@ -18,36 +18,21 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_agent"
 
-let failures = ref 0
+(* The counter, the scratch paths, the poll and the connect are in
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+   test_support.ml — the note there on why a retry is narrowed to
+   ECONNREFUSED is this file's own reasoning, moved with the code it explains.
 
-let scratch = Filename.get_temp_dir_name ()
+   Both budgets below are shorter than the shared defaults, and deliberately:
-let tmp name = Filename.concat scratch ("flan-agent-" ^ name)
+   everything this file waits on is a program that has already been built and
-
+   launched, so three seconds is a wait for a bind rather than for a compile,
-(* Poll for a condition rather than sleeping a fixed time: the program has to
+   and the two the connect retries for are the width of the bind/listen race
-   bind its socket before there is anything to connect to, and how long that
+   itself. *)
-   takes is not ours to predict. *)
+let fail fmt = Test_support.fail fmt
-let rec await ?(ms = 3000) f =
+let tmp name = Test_support.tmp "flan-agent-" name
-  if f () then true
+let await ?(ms = 3000) f = Test_support.await ~ms f
-  else if ms <= 0 then false
-  else begin
-    ignore (Unix.select [] [] [] 0.005);
-    await ~ms:(ms - 5) f
-  end
-
-(* The socket file appears at [bind], which is a moment before [listen], so a
-   connect can lose that race and get ECONNREFUSED. Retry rather than sleep. *)
-let rec connect ?(ms = 2000) path =
-  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-  match Unix.connect s (Unix.ADDR_UNIX path) with
-  | () -> s
-  | exception Unix.Unix_error (Unix.ECONNREFUSED, _, _) when ms > 0 ->
-    Unix.close s;
-    ignore (Unix.select [] [] [] 0.005);
-    connect ~ms:(ms - 5) path
 
 let send path line =
-  let s = connect path in
+  let s = Test_support.connect ~ms:2000 path in
   let msg = line ^ "\n" in
   ignore (Unix.write_substring s msg 0 (String.length msg));
   (* Read to EOF, not once: a reply arrives in several pieces, and closing
@@ -555,9 +540,5 @@ let () =
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ exe; so1; so2; sock; out; bsock; bout; bexe; qexe; qso; qsock; qout;
         noinstall; lexe; lsock; lout ];
-    if !failures = 0 then print_endline "agent: all tests passed"
+    Test_support.report ~label:"agent" ()
-    else begin
-      Printf.printf "\n%d failure(s)\n" !failures;
-      exit 1
-    end
   | _ -> print_endline "agent: skipped (no clang or llc on PATH)"

test/test_dev.ml

@@ -12,72 +12,16 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:900 "test_dev"
 
-let failures = ref 0
+(* The counter, the scratch paths, the poll and the daemon wait are all in
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+   test_support.ml, which is where [listening]'s long note about telling a
-
+   still-building daemon from a dead one now lives too. The watchdog armed
-let scratch = Filename.get_temp_dir_name ()
+   just above is what bounds this particular run. *)
-let tmp n = Filename.concat scratch ("flan-devtest-" ^ n)
+let failures = Test_support.failures
-
+let fail fmt = Test_support.fail fmt
-let rec await ?(ms = 5000) f =
+let tmp n = Test_support.tmp "flan-devtest-" n
-  if f () then true
+let await = Test_support.await
-  else if ms <= 0 then false
+let listen_why = Test_support.listen_why
-  else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end
+let listening = Test_support.listening
-
-(* 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.
-
-   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
-       (* 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 \
-            build that did not finish, not the socket"
-           (ms / 1000) path);
-    false
-  end
 
 (* ── Three states, without a program to be in them ──────────────────── *)
 
@@ -150,14 +94,7 @@ let () =
     (Dev.orphaned ~grace:0. ~served:true ~idle:10_000. Dev.Parked)
     false
 
-let rec connect ?(ms = 5000) path =
+let connect = Test_support.connect
-  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
-  match Unix.connect s (Unix.ADDR_UNIX path) with
-  | () -> s
-  | exception Unix.Unix_error (_, _, _) when ms > 0 ->
-    Unix.close s;
-    ignore (Unix.select [] [] [] 0.005);
-    connect ~ms:(ms - 5) path
 
 (* The program's own output arrives on the replies, not on a file: the daemon
    reads its stdout through a pipe so an editor can see it. Every reply is
@@ -174,13 +111,7 @@ let request fd sexp =
 let status r =
   match Wire.string_field r "status" with Some s -> s | None -> "<none>"
 
-let contains_sub hay needle =
+let contains_sub = Test_support.contains
-  let n = String.length needle in
-  let rec go i =
-    i + n <= String.length hay
-    && (String.equal (String.sub hay i n) needle || go (i + 1))
-  in
-  go 0
 
 (* ── Whose fault a full reload ring is ──────────────────────────────── *)
 
@@ -2668,11 +2599,7 @@ let () =
       in
       let text r = Option.value ~default:"" (Wire.string_field r "text") in
       let basis r = Option.value ~default:"" (Wire.string_field r "basis") in
-      let has hay needle =
+      let has = contains_sub in
-        let n = String.length needle and h = String.length hay in
-        let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-        n > 0 && go 0
-      in
       let have_objdump =
         Sys.command "command -v objdump > /dev/null 2>&1" = 0
       in
@@ -2894,11 +2821,7 @@ let () =
     end
     else begin
       let c = connect ssock in
-      let has hay needle =
+      let has = contains_sub in
-        let n = String.length needle and h = String.length hay in
-        let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-        n > 0 && go 0
-      in
       let r =
         request c
           "(:op \"eval\" :code \"(defn step [] i64 (set ticks (+ ticks 9)) ticks)\" :file \"/tmp/never-landed.flan\")"
@@ -3110,13 +3033,7 @@ let () =
               else In_channel.with_open_bin dump In_channel.input_all
             in
             (try Sys.remove dump with Sys_error _ -> ());
-            let has hay needle =
+            let has = contains_sub in
-              let n = String.length needle and h = String.length hay in
-              let rec go i =
-                i + n <= h && (String.sub hay i n = needle || go (i + 1))
-              in
-              n > 0 && go 0
-            in
             if not (has text "dbg.flan") then
               fail
                 "a --debug daemon's module carries no line table for the form's \
@@ -4821,9 +4738,5 @@ let () =
 
     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"
+    Test_support.report ~label:"dev" ()
-    else begin
-      Printf.printf "\n%d failure(s)\n" !failures;
-      exit 1
-    end
   | _ -> print_endline "dev: skipped (no clang or llc on PATH)"

test/test_dyn.ml

@@ -51,26 +51,15 @@ open Flan
    all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_dyn"
 
-let failures = ref 0
+let failures = Test_support.failures
-let fail fmt =
+let fail fmt = Test_support.fail fmt
-  Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+let tmp name = Test_support.tmp "flan-dyn-" name
-
+let has = Test_support.contains
-let scratch = Filename.get_temp_dir_name ()
-let tmp name = Filename.concat scratch ("flan-dyn-" ^ name)
-
-let has hay needle =
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  go 0
 
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1" with
   | 0 ->
-    let p =
+    let p = Test_support.checked "programs/dyn-host.flan" in
-      Check.program
-        (Load.program ~file:"programs/dyn-host.flan"
-           (Reader.read_file "programs/dyn-host.flan")).Load.decls
-    in
     let exe = tmp "ops" in
     ignore (Build.executable ~csrcs:[ "dyn_ops.c" ] p ~out:exe);
 

test/test_emacs.ml

@@ -12,53 +12,15 @@
 (* The watchdog first: a hang is the one failure mode that reports
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_emacs"
-let scratch = Filename.get_temp_dir_name ()
+(* The scratch paths, the poll and the daemon wait are in test_support.ml. The
-let tmp n = Filename.concat scratch ("flan-emacs-" ^ n)
+   long note on what [listening] can and cannot tell apart is there with it. *)
-
+let tmp n = Test_support.tmp "flan-emacs-" n
-let rec await ?(ms = 8000) f =
+let await = Test_support.await
-  if f () then true
+let listen_why = Test_support.listen_why
-  else if ms <= 0 then false
+let listening = Test_support.listening
-  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
-       (* 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 \
-            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
+  let have = Test_support.have in
   if not (have "emacs") then print_endline "emacs: skipped (no emacs on PATH)"
   else if not (have "clang" && have "llc") then
     print_endline "emacs: skipped (no clang or llc on PATH)"

test/test_flan.ml

@@ -7,7 +7,7 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_flan"
 
-let failures = ref 0
+let failures = Test_support.failures
 
 let check name cond =
   if not cond then begin
@@ -15,10 +15,7 @@ let check name cond =
     Printf.printf "FAIL  %s\n" name
   end
 
-let contains hay needle =
+let contains = Test_support.contains
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  n = 0 || go 0
 
 (* Every read in this table runs under a five-second alarm. The reader is the
    one part of the compiler whose mistakes loop rather than raise — a branch
@@ -281,11 +278,7 @@ let () =
      check "multi-line span has no single-line width" (Loc.width l.loc = None)
    | _ -> check "span: one multi-line form" false);
 
-  if !failures = 0 then print_endline "reader: all tests passed"
+  Test_support.report ~label:"reader" ()
-  else begin
-    Printf.printf "\n%d failure(s)\n" !failures;
-    exit 1
-  end
 
 (* ═══ Parse: forms → AST ═══════════════════════════════════════════ *)
 
@@ -677,11 +670,7 @@ let () =
        dep in test/dune and lands at the build root. *)
     [ "../calc-me.flan"; "../sand.flan" ];
 
-  if !failures = 0 then print_endline "parse: all tests passed"
+  Test_support.report ~label:"parse" ()
-  else begin
-    Printf.printf "\n%d failure(s)\n" !failures;
-    exit 1
-  end
 
 (* ═══ The return type is the slot, not a guess ══════════════ *)
 (* (Option f64) and (Some 1) are the same s-expression shape, and the parser
@@ -3579,8 +3568,4 @@ let () =
   accepts "calc-me.flan type checks"
     (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);
 
-  if !failures = 0 then print_endline "all tests passed"
+  Test_support.report ()
-  else begin
-    Printf.printf "\n%d failure(s)\n" !failures;
-    exit 1
-  end

test/test_reload.ml

@@ -25,15 +25,9 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_reload"
 
-let failures = ref 0
+let fail fmt = Test_support.fail fmt
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+let tmp name = Test_support.tmp "flan-reload-" name
-
+let checked = Test_support.checked
-let scratch = Filename.get_temp_dir_name ()
-let tmp name = Filename.concat scratch ("flan-reload-" ^ name)
-
-let checked path =
-  Check.program
-    (Load.program ~file:path (Reader.read_file path)).Load.decls
 
 let ms f =
   let t0 = Unix.gettimeofday () in
@@ -632,9 +626,5 @@ let () =
 
     List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
       [ host; limits; so1; so2; so3; so4; so5; out; out5; err5; tmp "err" ];
-    if !failures = 0 then print_endline "reload: all tests passed"
+    Test_support.report ~label:"reload" ()
-    else begin
-      Printf.printf "\n%d failure(s)\n" !failures;
-      exit 1
-    end
   | _ -> print_endline "reload: skipped (no clang or llc on PATH)"

test/test_repl.ml

@@ -20,77 +20,24 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_repl"
 
-let failures = ref 0
+(* The counter, the poll, the daemon wait and the connect are all in
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+   test_support.ml: see its header for why they are not here. *)
-
+let failures = Test_support.failures
-let scratch = Filename.get_temp_dir_name ()
+let fail fmt = Test_support.fail fmt
-let tmp n = Filename.concat scratch ("flan-repl-" ^ n)
+let tmp n = Test_support.tmp "flan-repl-" n
-
+let listen_why = Test_support.listen_why
-let rec await ?(ms = 8000) f =
+let listening = Test_support.listening
-  if f () then true
+let connect = Test_support.connect
-  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
-       (* 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 \
-            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
-  | () -> s
-  | exception Unix.Unix_error _ when ms > 0 ->
-    Unix.close s;
-    ignore (Unix.select [] [] [] 0.005);
-    connect ~ms:(ms - 5) path
 
 let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd)
 let field r k = Wire.string_field r k
 let status r = match field r "status" with Some s -> s | None -> "<none>"
 
-let quote s =
+(* [Wire.quote] itself, not a copy of it: the escaping the daemon's own
-  let b = Buffer.create (String.length s + 8) in
+   replies are written with is the escaping a request has to be written with,
-  Buffer.add_char b '"';
+   and the case below named "every string escape survives the printer and the
-  String.iter
+   wire" is checking exactly that function's stated ground. *)
-    (fun c ->
+let quote = Wire.quote
-       if c = '"' || c = '\\' then Buffer.add_char b '\\';
-       Buffer.add_char b c)
-    s;
-  Buffer.add_char b '"';
-  Buffer.contents b
 
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
@@ -112,7 +59,7 @@ let () =
     if not (listening ~pid sock) then
       fail "the daemon %s" !listen_why
     else begin
-      let c = connect sock in
+      let c = connect ~ms:8000 sock in
       let evals code =
         request c
           (Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")"

test/test_sanitize.ml

@@ -35,11 +35,9 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:3600 "test_sanitize"
 
-let failures = ref 0
+let failures = Test_support.failures
-let fail fmt =
+let fail fmt = Test_support.fail fmt
-  Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+let scratch = Test_support.scratch
-
-let scratch = Filename.get_temp_dir_name ()
 
 (* Leaks are off. Every allocation in the runtime is allocate-once-never-free
    by design — [rt_args] says so in its own comment — so LeakSanitizer here
@@ -70,18 +68,13 @@ let compile ~sanitize ~checks path =
          (if sanitize then "s" else "p")
          (Filename.remove_extension (Filename.basename path)))
   in
-  let l = Load.program ~file:path (Reader.read_file path) in
+  let p, csrcs, lflags = Test_support.linked path in
-  let p = Check.program l.Load.decls in
-  let p, csrcs, lflags = Reach.link ~dev:false l p in
   ignore
     (Build.executable
        ~opts:{ Build.default with checks; sanitize } ~csrcs ~lflags p ~out:exe);
   exe
 
-let contains hay needle =
+let contains = Test_support.contains
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  go 0
 
 (* What a report looks like, whichever sanitizer wrote it. *)
 let markers =
@@ -291,9 +284,7 @@ let sweep ~checks label =
 let dyn_sweep () =
   let exe = Filename.concat scratch "flan-san-dyn" in
   let path = "programs/dyn-host.flan" in
-  let l = Load.program ~file:path (Reader.read_file path) in
+  let p, csrcs, lflags = Test_support.linked path in
-  let p = Check.program l.Load.decls in
-  let p, csrcs, lflags = Reach.link ~dev:false l p in
   match
     Build.executable
       ~opts:{ Build.default with Build.sanitize = true }

test/test_session.ml

@@ -13,19 +13,12 @@ open Flan
    nothing at all. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:600 "test_session"
 
-let failures = ref 0
+let fail fmt = Test_support.fail fmt
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+let has = Test_support.contains
-
-let has hay needle =
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  go 0
 
 (* Every rejection is asserted on its reason, not just on the failure: the
    reason is the part that has to survive a refactor. *)
-let checked_program file =
+let checked_program = Test_support.checked
-  Check.program
-    (Load.program ~file (Reader.read_file file)).Load.decls
 
 let refuses ?(file = "programs/reload.flan") name src reason =
   let t, _ = Session.create ~file () in
@@ -997,8 +990,4 @@ let () =
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "an expression that instantiates a generic: %s" m);
 
-  if !failures = 0 then print_endline "session: all tests passed"
+  Test_support.report ~label:"session" ()
-  else begin
-    Printf.printf "\n%d failure(s)\n" !failures;
-    exit 1
-  end

test/test_support.ml

@@ -0,0 +1,207 @@
+(* The plumbing every test binary in this directory needs, in one place.
+
+   Nothing here tests anything. It is the scaffolding the cases stand on: a
+   failure counter and the three lines that report it, a poll, a socket
+   connect that survives the bind/listen race, the wait for a [flan dev]
+   daemon to come up, a substring search, and the Load → Check → Reach.link
+   front half of a compile.
+
+   It exists because each of those had been written out again in every file
+   that wanted it — [listening] three times byte for byte apart from one
+   comment, the substring search ten times, a report tail in every suite — and
+   two of those copies carried a comment saying they were kept separate
+   because "these three files have no module between them". That was not true
+   when it was written: watchdog.ml was already named in the same
+   [(modules ...)] stanzas, which is exactly the module between them. This
+   file is the second such module, named in all four of test/dune's stanzas
+   the way watchdog is in three of them.
+
+   No [let () = ...] at the top level here on purpose. A module linked into
+   ten binaries must not do anything on the way in; the watchdog is armed by
+   each test's own first line, where the seconds are that test's decision. *)
+
+open Flan
+
+(* ── Failures, and the report of them ─────────────────────────────── *)
+
+(* One counter per process, and every [fail] goes through it. Each binary
+   binds its own [failures] to this ref rather than making one of its own, so
+   [report] below sees what the file's own [incr failures] did. *)
+let failures = ref 0
+
+let fail fmt =
+  Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+
+(* The tail every suite ends on: a single line when nothing failed, and a
+   count plus a nonzero exit when something did. The label names the suite,
+   because these binaries run under dune's parallelism and their output is
+   interleaved — "all tests passed" on its own says nothing about which.
+   [?label] is optional for the one caller that has no label to give: the
+   last of test_flan.ml's three tails covers the whole file and has always
+   printed the bare sentence, and this keeps that byte for byte.
+
+   Not every tail in this directory is this one, and the others are left
+   where they are: test_repl.ml quotes the daemon's exit status underneath
+   the count, test_web.ml says "web: ok", and the two sweep binaries print a
+   count without exiting on the spot. Those differ because they report
+   different things, not because they drifted. *)
+let report ?label () =
+  if !failures = 0 then
+    print_endline
+      (match label with
+       | Some l -> l ^ ": all tests passed"
+       | None -> "all tests passed")
+  else begin
+    Printf.printf "\n%d failure(s)\n" !failures;
+    exit 1
+  end
+
+(* ── Strings ──────────────────────────────────────────────────────── *)
+
+(* Substring search, hand-written because Str is a dependency the rest of
+   this directory does not take (test_valgrind.ml is the one exception, and
+   it takes it for a regexp over memcheck's summary line).
+
+   An empty needle is contained in anything, which is the answer the majority
+   of the copies this replaces gave and the one that agrees with every other
+   [contains] in the world. Three inline copies in test_dev.ml answered
+   [false] instead; every needle passed to any of them was a non-empty string
+   literal, so no call site could tell the difference. *)
+let contains hay needle =
+  let n = String.length needle and h = String.length hay in
+  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
+  go 0
+
+(* ── Scratch files ────────────────────────────────────────────────── *)
+
+let scratch = Filename.get_temp_dir_name ()
+
+(* [tmp prefix name] is a path in the scratch directory. The prefix is the
+   caller's, not a default, and that is the point: these binaries run at the
+   same time under dune, so "flan-agent-dev.sock" and "flan-repl-dev.sock"
+   being different files is what keeps two suites from unlinking each other's
+   sockets. *)
+let tmp prefix name = Filename.concat scratch (prefix ^ name)
+
+(* ── Toolchain probes ─────────────────────────────────────────────── *)
+
+(* Whether a program is on PATH. Missing tools are a skip with the reason in
+   this directory, never a red test — the compiler does not depend on emacs,
+   emscripten or valgrind being installed. *)
+let have prog =
+  Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" prog) = 0
+
+(* ── Waiting ──────────────────────────────────────────────────────── *)
+
+(* Poll for a condition rather than sleeping a fixed time: a program has to
+   bind its socket before there is anything to connect to, and how long that
+   takes is not ours to predict. Five milliseconds a turn, [ms] milliseconds
+   in total, [false] if the budget ran out.
+
+   Five seconds by default, which is what test_dev.ml's copy had and what its
+   several dozen bare call sites were written against. The callers that want
+   another budget pass one. *)
+let rec await ?(ms = 5000) f =
+  if f () then true
+  else if ms <= 0 then false
+  else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end
+
+(* The socket file appears at [bind], which is a moment before [listen], so a
+   connect can lose that race and get ECONNREFUSED. Retry rather than sleep.
+
+   ECONNREFUSED and not any [Unix_error], which is the narrower of the two
+   spellings this had grown. The wide one retried ENOENT and EACCES to the
+   full timeout as well, so a path that was never going to exist cost seconds
+   before raising something a reader still had to interpret; narrowed, those
+   two come straight back out of [Unix.connect] with their own name on them.
+   Every caller here connects to a socket [listening] has already seen on
+   disk, so the race this does catch is the only one left. *)
+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
+  | () -> s
+  | exception Unix.Unix_error (Unix.ECONNREFUSED, _, _) when ms > 0 ->
+    Unix.close s;
+    ignore (Unix.select [] [] [] 0.005);
+    connect ~ms:(ms - 5) path
+
+(* 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.
+
+   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. Each caller's watchdog is still what bounds its run.
+
+   [!listen_why] carries the reason to the caller so each site can keep its own
+   name for its daemon. One ref is enough even though three binaries now share
+   this code: they are three processes, each 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
+       (* 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 \
+            build that did not finish, not the socket"
+           (ms / 1000) path);
+    false
+  end
+
+(* ── The front half of a compile ──────────────────────────────────── *)
+
+(* Read, load and check a program: the same two calls [flan build] makes
+   before it reaches the backend. Through [Load], so a program with an
+   (import ...) is buildable here — it brings back the package's declarations
+   as well as the file's own. *)
+let checked path =
+  Check.program (Load.program ~file:path (Reader.read_file path)).Load.decls
+
+(* And the third call, which is where the binaries below actually differ from
+   one another: [Reach.link] decides the link from the checked program — a
+   package nothing reachable calls into hands over no C and no linker
+   argument, and its functions are not emitted — and returns the program
+   together with the C sources and linker flags the build needs.
+
+   This stops at [Build.executable] deliberately. Every caller passes a
+   different [Build.opts] (a sanitized build, a -O0 one, an x86 one, a web
+   one) and several want the exception rather than the executable, so the
+   options record is the one part that is genuinely theirs. *)
+let linked ?(dev = false) path =
+  let l = Load.program ~file:path (Reader.read_file path) in
+  let p = Check.program l.Load.decls in
+  Reach.link ~dev l p

test/test_valgrind.ml

@@ -36,11 +36,9 @@ open Flan
    slower, so the clock is looser than the sanitize sweep's. See watchdog.ml. *)
 let () = Watchdog.arm ~seconds:5400 "test_valgrind"
 
-let failures = ref 0
+let failures = Test_support.failures
-let fail fmt =
+let fail fmt = Test_support.fail fmt
-  Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
+let scratch = Test_support.scratch
-
-let scratch = Filename.get_temp_dir_name ()
 let supp = "valgrind.supp"
 
 (* Leak checking is off, and the reason is [test_sanitize.ml]'s reason for
@@ -98,9 +96,7 @@ let compile ~checks path =
          (if checks then "c" else "u")
          (Filename.remove_extension (Filename.basename path)))
   in
-  let l = Load.program ~file:path (Reader.read_file path) in
+  let p, csrcs, lflags = Test_support.linked path in
-  let p = Check.program l.Load.decls in
-  let p, csrcs, lflags = Reach.link ~dev:false l p in
   ignore
     (Build.executable
        ~opts:{ Build.default with checks } ~csrcs ~lflags p ~out:exe);

test/test_web.ml

@@ -14,11 +14,9 @@
 
 open Flan
 
-let failures = ref 0
+let failures = Test_support.failures
-
+let scratch = Test_support.scratch
-let scratch = Filename.get_temp_dir_name ()
+let fail fmt = Test_support.fail fmt
-
-let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt
 
 let read path =
   let ch = open_in_bin path in
@@ -26,19 +24,13 @@ let read path =
   let s = really_input_string ch n in
   close_in ch; s
 
-let contains hay needle =
+let contains = Test_support.contains
-  let n = String.length needle and h = String.length hay in
+let have = Test_support.have
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  go 0
-
-let have prog = Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" prog) = 0
 
 (* One web build, through [Load] and [Reach] exactly as [flan build] does it,
    so a package's per-target link lines are selected here too. *)
 let web_build ?(opt = "-O2") path out =
-  let l = Load.program ~file:path (Reader.read_file path) in
+  let p, csrcs, lflags = Test_support.linked path in
-  let p = Check.program l.Load.decls in
-  let p, csrcs, lflags = Reach.link l p in
   ignore
     (Build.executable ~opts:{ Build.default with opt; target = Some "web" }
        ~csrcs ~lflags p ~out)
@@ -279,11 +271,7 @@ let () =
       else if not (contains m why) then
         fail "%s was refused for the wrong reason: wanted %S, said %S" what why m
   in
-  let unit_main () =
+  let unit_main () = Test_support.checked "programs/unit-main.flan" in
-    let path = "programs/unit-main.flan" in
-    let l = Load.program ~file:path (Reader.read_file path) in
-    Check.program l.Load.decls
-  in
   refused "--dev --target=web" "--dev is native only" (fun () ->
     ignore
       (Build.executable ~opts:{ Build.default with target = Some "web"; dev = true }