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

A test binary's directory is one it made fresh, and a same-pid name already there when it started is not counted as its leftover

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 09:56:25 +07:00
parent 931000fcb5
commit f7deba7a3e
2 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.org
View File

@ -1708,7 +1708,8 @@ flake and a flake is how a watchdog gets deleted.
** DONE A test binary leaves nothing in the temporary directory it was given ** DONE A test binary leaves nothing in the temporary directory it was given
CLOSED: [2026-09-25] CLOSED: [2026-09-25]
Every test binary makes =flan-t<pid>= under its =TMPDIR=, exports it as 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 =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 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 directory survives or if a =flan-<pid>= or =flan-dev-<pid>= for its own pid

40
test/own_tmp.ml
View File

@ -37,11 +37,25 @@ let owner = Unix.getpid ()
(* Short, because a Unix socket path has 108 bytes and the sockets the tests (* 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 bind are under here: [flan-dev-<pid>/agent.sock], and names such as
[flan-devtest-halfwrite--llvm.sock]. *) [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 = let dir =
let d = Filename.concat outer (Printf.sprintf "flan-t%d" owner) in Random.self_init ();
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); let rec make tries =
d 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 () = let () =
Unix.putenv "TMPDIR" dir; Unix.putenv "TMPDIR" dir;
@ -61,13 +75,19 @@ let rec remove path =
if removing it failed, and a session or build directory named for this 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 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 or build that did not go through [dir] — something that read the temporary
directory before this module set it. *) 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 () = let leftovers () =
let mine = List.filter
[ Filename.concat outer (Printf.sprintf "flan-dev-%d" owner); (fun d -> Sys.file_exists d && not (List.mem d already))
Filename.concat outer (Printf.sprintf "flan-%d" owner) ] (dir :: named_for_me)
in
List.filter Sys.file_exists (dir :: mine)
(* Only the process that made the directory removes it. The binaries fork (* Only the process that made the directory removes it. The binaries fork
(test_acceptance's compile pool, the daemons before they exec), and a (test_acceptance's compile pool, the daemons before they exec), and a