A test binary runs under a temporary directory of its own and leaves nothing in the one it was given
This commit is contained in:
parent
11dc230974
commit
6a1182df5d
12
TODO.org
12
TODO.org
@ -1706,6 +1706,18 @@ 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
|
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.
|
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 =flan-t<pid>= under its =TMPDIR=, 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
|
** DONE A forked acceptance failure reaches the exit status
|
||||||
The fork pool is drained before anything reads the failure count, and a nonzero
|
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.
|
count is an exit status. A red row used to be able to print and pass.
|
||||||
|
|||||||
19
lib/build.ml
19
lib/build.ml
@ -43,13 +43,30 @@ let read_file_opt path =
|
|||||||
try Some (read_file path) with Sys_error _ -> None
|
try Some (read_file path) with Sys_error _ -> None
|
||||||
|
|
||||||
(* One temporary directory per build, so the .ll is findable by name when
|
(* 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 workdir () =
|
||||||
let d =
|
let d =
|
||||||
Filename.concat (Filename.get_temp_dir_name ())
|
Filename.concat (Filename.get_temp_dir_name ())
|
||||||
(Printf.sprintf "flan-%d" (Unix.getpid ()))
|
(Printf.sprintf "flan-%d" (Unix.getpid ()))
|
||||||
in
|
in
|
||||||
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
(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
|
d
|
||||||
|
|
||||||
(* [mkdir -p]: each component in turn, [EEXIST] swallowed at each, because the
|
(* [mkdir -p]: each component in turn, [EEXIST] swallowed at each, because the
|
||||||
|
|||||||
@ -46,7 +46,7 @@
|
|||||||
; wanted them had each been carrying their own copy of.
|
; wanted them had each been carrying their own copy of.
|
||||||
(modules test_flan test_acceptance test_reload test_agent test_session
|
(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)
|
test_support own_tmp)
|
||||||
(libraries flan unix)
|
(libraries flan unix)
|
||||||
(deps
|
(deps
|
||||||
(alias corpus)
|
(alias corpus)
|
||||||
@ -87,7 +87,7 @@
|
|||||||
; skips with the reason, so it is green on a machine that has neither.
|
; skips with the reason, so it is green on a machine that has neither.
|
||||||
(test
|
(test
|
||||||
(name test_web)
|
(name test_web)
|
||||||
(modules test_web test_support)
|
(modules test_web test_support own_tmp)
|
||||||
(libraries flan unix)
|
(libraries flan unix)
|
||||||
(deps
|
(deps
|
||||||
(alias corpus)
|
(alias corpus)
|
||||||
@ -105,7 +105,7 @@
|
|||||||
; is the whole point here.
|
; is the whole point here.
|
||||||
(executable
|
(executable
|
||||||
(name test_sanitize)
|
(name test_sanitize)
|
||||||
(modules test_sanitize watchdog test_support)
|
(modules test_sanitize watchdog test_support own_tmp)
|
||||||
(libraries flan unix))
|
(libraries flan unix))
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
@ -141,7 +141,7 @@
|
|||||||
; asked for exactly this.
|
; asked for exactly this.
|
||||||
(executable
|
(executable
|
||||||
(name test_valgrind)
|
(name test_valgrind)
|
||||||
(modules test_valgrind watchdog test_support)
|
(modules test_valgrind watchdog test_support own_tmp)
|
||||||
(libraries flan unix str))
|
(libraries flan unix str))
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
|
|||||||
108
test/own_tmp.ml
Normal file
108
test/own_tmp.ml
Normal file
@ -0,0 +1,108 @@
|
|||||||
|
(* 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]. *)
|
||||||
|
let dir =
|
||||||
|
let d = Filename.concat outer (Printf.sprintf "flan-t%d" owner) in
|
||||||
|
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
||||||
|
d
|
||||||
|
|
||||||
|
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. *)
|
||||||
|
let leftovers () =
|
||||||
|
let mine =
|
||||||
|
[ Filename.concat outer (Printf.sprintf "flan-dev-%d" owner);
|
||||||
|
Filename.concat outer (Printf.sprintf "flan-%d" owner) ]
|
||||||
|
in
|
||||||
|
List.filter Sys.file_exists (dir :: mine)
|
||||||
|
|
||||||
|
(* 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;
|
||||||
|
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)
|
||||||
@ -38,7 +38,7 @@ let failures = Test_support.failures
|
|||||||
handler's [exit] call would do to it. *)
|
handler's [exit] call would do to it. *)
|
||||||
let () =
|
let () =
|
||||||
at_exit (fun () ->
|
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
|
let scratch = Test_support.scratch
|
||||||
|
|
||||||
|
|||||||
@ -82,7 +82,7 @@ let contains hay needle =
|
|||||||
|
|
||||||
(* ── Scratch files ────────────────────────────────────────────────── *)
|
(* ── 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
|
(* [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
|
caller's, not a default, and that is the point: these binaries run at the
|
||||||
|
|||||||
@ -62,6 +62,7 @@ let dying _ =
|
|||||||
coordinating with what is in it, and does not depend on how many
|
coordinating with what is in it, and does not depend on how many
|
||||||
handlers get added there later. *)
|
handlers get added there later. *)
|
||||||
flush_all ();
|
flush_all ();
|
||||||
|
Own_tmp.release ();
|
||||||
Unix._exit 2
|
Unix._exit 2
|
||||||
|
|
||||||
(* Re-arm the backstop for whatever is left of its budget. One second is the
|
(* Re-arm the backstop for whatever is left of its budget. One second is the
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user