A test binary leaves nothing in the temporary directory it was given

TODO.org

@@ -1746,6 +1746,19 @@ as it is left to; in CI that is a job the runner kills with nothing named. The
 alarm is generous on purpose, because an alarm that fires on a slow machine is a
 flake and a flake is how a watchdog gets deleted.
 
+** DONE A test binary leaves nothing in the temporary directory it was given
+CLOSED: [2026-09-25]
+Every test binary makes a fresh =flan-t<pid>-<hex>= under its =TMPDIR=, never
+adopting an existing entry, exports it as
+=TMPDIR= to everything it starts, and removes it on exit, on the watchdog, and
+on SIGINT or SIGTERM (=test/own_tmp.ml=). A binary exits nonzero if that
+directory survives or if a =flan-<pid>= or =flan-dev-<pid>= for its own pid
+appears beside it. =dune test= was already clean, since dune gives every action
+a private =TMPDIR=; the directories in /tmp came from binaries run directly or
+through =dune exec=. A build's empty =flan-<pid>= goes at process exit. Rules out
+a sweep that deletes directories by pid liveness, and any change to a killed or
+crashed session keeping its directory.
+
 ** DONE A forked acceptance failure reaches the exit status
 The fork pool is drained before anything reads the failure count, and a nonzero
 count is an exit status. A red row used to be able to print and pass.

lib/build.ml

@@ -43,13 +43,30 @@ let read_file_opt path =
   try Some (read_file path) with Sys_error _ -> None
 
 (* One temporary directory per build, so the .ll is findable by name when
-   something is wrong with it. *)
+   something is wrong with it.
+
+   A build that succeeds removes what it wrote there, and the directory itself
+   goes when the process exits: [rmdir], which only removes an empty directory,
+   so a failed build's files and the directory holding them stay. Not before
+   exit, because every build in the process shares the directory and one that
+   removed it would pull it out from under the next write of another. Only by
+   the process that made it: a forked child exiting through [exit] runs the
+   parent's handlers too. *)
+let workdir_exit = ref None
+
 let workdir () =
   let d =
     Filename.concat (Filename.get_temp_dir_name ())
       (Printf.sprintf "flan-%d" (Unix.getpid ()))
   in
   (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
+  if !workdir_exit <> Some d then begin
+    workdir_exit := Some d;
+    let pid = Unix.getpid () in
+    at_exit (fun () ->
+      if Unix.getpid () = pid then
+        try Unix.rmdir d with Unix.Unix_error _ -> ())
+  end;
   d
 
 (* [mkdir -p]: each component in turn, [EEXIST] swallowed at each, because the

test/dune

@@ -46,7 +46,7 @@
  ; 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_support)
+          test_support own_tmp)
  (libraries flan unix)
  (deps
   (alias corpus)
@@ -87,7 +87,7 @@
 ; skips with the reason, so it is green on a machine that has neither.
 (test
  (name test_web)
- (modules test_web test_support)
+ (modules test_web test_support own_tmp)
  (libraries flan unix)
  (deps
   (alias corpus)
@@ -105,7 +105,7 @@
 ; is the whole point here.
 (executable
  (name test_sanitize)
- (modules test_sanitize watchdog test_support)
+ (modules test_sanitize watchdog test_support own_tmp)
  (libraries flan unix))
 
 (rule
@@ -141,7 +141,7 @@
 ; asked for exactly this.
 (executable
  (name test_valgrind)
- (modules test_valgrind watchdog test_support)
+ (modules test_valgrind watchdog test_support own_tmp)
  (libraries flan unix str))
 
 (rule

test/own_tmp.ml

@@ -0,0 +1,132 @@
+(* Every test binary runs under a temporary directory of its own, and takes it
+   away when it exits.
+
+   A [flan dev] session keeps its program, its socket and every module it was
+   sent in [$TMPDIR/flan-dev-<pid>], and a build keeps its files in
+   [$TMPDIR/flan-<pid>]. A session told to [close] removes both; one that is
+   killed or crashes leaves them, because what a crashed session was running is
+   what there is to look at afterwards. The suite kills and crashes daemons on
+   purpose, so every run of test_dev leaves a score of those behind.
+
+   Under [dune test] that never reached /tmp: dune hands every action a
+   [TMPDIR] of its own and removes it when the build ends. A binary run any
+   other way — [dune exec], or [_build/default/test/test_dev.exe] in a loop
+   while chasing a flake — has no such directory, and each run put its
+   sessions' directories straight into /tmp, which is a tmpfs.
+
+   So the directory those land in is this binary's. It is made when this module
+   is initialised, which is before any test module's own top level runs,
+   because [Test_support] and [Watchdog] both refer to it and every binary here
+   refers to one of them (test_cider only to [Watchdog], through [dying]'s call
+   to [release] — take that call out and test_cider loses its directory). It is
+   exported as [TMPDIR] as well as set as OCaml's temporary directory, so every
+   [flan dev], emacs and program this binary starts puts its directories under
+   it too; every child here is started with an environment derived from
+   [Unix.environment ()], which carries it.
+
+   It is removed however the binary ends: a normal exit, a failing one, an
+   uncaught exception, the watchdog, or SIGINT or SIGTERM. SIGKILL is the one
+   end nothing can follow.
+
+   Nothing here decides whether a session is over. The tree goes because the
+   binary that owns it is exiting, and anything in it was made by this binary
+   or by something it started. *)
+
+let outer = Filename.get_temp_dir_name ()
+let owner = Unix.getpid ()
+
+(* Short, because a Unix socket path has 108 bytes and the sockets the tests
+   bind are under here: [flan-dev-<pid>/agent.sock], and names such as
+   [flan-devtest-halfwrite--llvm.sock].
+
+   Made fresh, never adopted: [mkdir] fails on any existing entry, a symlink
+   included, and a name that is taken is passed over for another. So the
+   directory this binary removes at exit is one it provably created, and
+   nothing someone else put at that name is followed or deleted. *)
+let dir =
+  Random.self_init ();
+  let rec make tries =
+    let d =
+      Filename.concat outer
+        (Printf.sprintf "flan-t%d-%04x" owner (Random.bits () land 0xffff))
+    in
+    match Unix.mkdir d 0o700 with
+    | () -> d
+    | exception Unix.Unix_error (Unix.EEXIST, _, _) when tries > 0 ->
+      make (tries - 1)
+  in
+  make 100
+
+let () =
+  Unix.putenv "TMPDIR" dir;
+  Filename.set_temp_dir_name dir
+
+let rec remove path =
+  match (Unix.lstat path).Unix.st_kind with
+  | Unix.S_DIR ->
+    Array.iter
+      (fun n -> remove (Filename.concat path n))
+      (try Sys.readdir path with Sys_error _ -> [||]);
+    (try Unix.rmdir path with Unix.Unix_error _ -> ())
+  | _ -> (try Unix.unlink path with Unix.Unix_error _ -> ())
+  | exception Unix.Unix_error _ -> ()
+
+(* What this binary left where it should have left nothing: its own directory,
+   if removing it failed, and a session or build directory named for this
+   process in the directory it was given. The second is an in-process session
+   or build that did not go through [dir] — something that read the temporary
+   directory before this module set it. A name already there when this binary
+   started belongs to an earlier process that had the same pid, and is not
+   counted. *)
+let named_for_me =
+  [ Filename.concat outer (Printf.sprintf "flan-dev-%d" owner);
+    Filename.concat outer (Printf.sprintf "flan-%d" owner) ]
+
+let already = List.filter Sys.file_exists named_for_me
+
+let leftovers () =
+  List.filter
+    (fun d -> Sys.file_exists d && not (List.mem d already))
+    (dir :: named_for_me)
+
+(* Only the process that made the directory removes it. The binaries fork
+   (test_acceptance's compile pool, the daemons before they exec), and a
+   forked child that ran this on its way out would take the directory from
+   under the parent that is still using it.
+
+   A leftover ends the process with status 1 on the spot. OCaml runs [at_exit]
+   before it prints an uncaught exception, so a binary that both raised and
+   leaked shows the leak and not the exception; one that only raised is
+   unaffected. *)
+let released = ref false
+
+let release () =
+  if Unix.getpid () = owner && not !released then begin
+    released := true;
+    remove dir;
+    (* Twice, because a child still exiting — a daemon's clang, a program
+       the test just signalled — can write between one pass's [readdir] and
+       its [rmdir], and a check that fails on that is a flake. *)
+    if Sys.file_exists dir then remove dir;
+    match leftovers () with
+    | [] -> ()
+    | left ->
+      Printf.printf
+        "FAIL  %s left temporary directories behind:\n%s\n"
+        (Filename.basename Sys.executable_name)
+        (String.concat "\n" (List.map (fun d -> "        " ^ d) left));
+      flush_all ();
+      Unix._exit 1
+  end
+
+let () =
+  at_exit release;
+  let stop n =
+    Sys.Signal_handle
+      (fun _ ->
+        (try release () with _ -> ());
+        flush_all ();
+        Unix._exit (128 + n))
+  in
+  Sys.set_signal Sys.sigint (stop 2);
+  Sys.set_signal Sys.sigterm (stop 15)

test/test_acceptance.ml

@@ -38,7 +38,7 @@ let failures = Test_support.failures
    handler's [exit] call would do to it. *)
 let () =
   at_exit (fun () ->
-    if !failures > 0 then begin flush_all (); Unix._exit 1 end)
+    if !failures > 0 then begin flush_all (); Own_tmp.release (); Unix._exit 1 end)
 
 let scratch = Test_support.scratch
 

test/test_support.ml

@@ -82,7 +82,7 @@ let contains hay needle =
 
 (* ── Scratch files ────────────────────────────────────────────────── *)
 
-let scratch = Filename.get_temp_dir_name ()
+let scratch = Own_tmp.dir
 
 (* [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

test/watchdog.ml

@@ -62,6 +62,7 @@ let dying _ =
      coordinating with what is in it, and does not depend on how many
      handlers get added there later. *)
   flush_all ();
+  Own_tmp.release ();
   Unix._exit 2
 
 (* Re-arm the backstop for whatever is left of its budget. One second is the