One process is a claim about the process table, so the test reads it

A reply over the socket looks the same either way, which is the point of the
merge and also why nothing in the suite noticed it. So the daemon's pid is
checked directly: /proc/<pid>/exe is the merged program, at a path named for
the pid that built it, and there is no child at all.

The same check runs the other way round over --two-process, which gets one
round trip of its own — describe, an eval, and the output coming back — because
it is the escape hatch for a machine that cannot build the compiler object and
an escape hatch nobody exercises is not one.

Linux only, by /proc, and skipped rather than faked elsewhere: what is being
asked about is the process table.
This commit is contained in:
Joseph Ferano 2026-09-12 21:47:33 +07:00
parent 1a1486a17b
commit 884d6a4d47

View File

@ -47,6 +47,14 @@ 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 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
let () =
match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
| 0 ->
@ -72,6 +80,31 @@ let () =
every step waits for the program to have got there. "ok" from an eval
means the module was queued, not that it has been installed. *)
let c = connect sock in
(* One process, which is the whole claim of the merge and the one thing
a reply cannot show. [flan dev] builds a binary that is the compiled
program *and* holds the compiler, and execs it so the pid this test
launched as [flan] is the program, and there is no child to find. The
path pins it further: the build directory is named for the pid that
made it, so finding it under /proc/<pid>/exe says the process that
built the program is the process now running it.
Linux only, by /proc. Elsewhere it is skipped rather than faked: what
is being checked is the process table, and there is no portable way to
ask. *)
if Sys.file_exists (Printf.sprintf "/proc/%d/exe" pid) then begin
let want =
Filename.concat
(Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" pid))
"program"
in
match Unix.readlink (Printf.sprintf "/proc/%d/exe" pid) with
| link when link = want -> ()
| link ->
fail "flan dev is still two processes: %s is running %s, not %s"
(string_of_int pid) link want
| exception Unix.Unix_error _ -> ()
end;
(* 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
means the module was queued, not that it has been installed. Output
@ -1689,6 +1722,65 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ]
end;
(* ── The escape hatch, which still has to work ─────────────────── *)
(* [--two-process] is the old shape: a compiler process that builds the
program, launches it as a child and talks to it over the agent socket.
It exists for a machine that cannot build the compiler object no
ocamlfind, no flan.cmxa beside the binary and it is what every
behaviour above was originally written against, so it is worth one
round trip rather than none. The same three questions, briefly: it
answers, it installs, and the program's output comes back. *)
let tsock = tmp "twoproc.sock" and tout = tmp "twoproc.out" in
(try Sys.remove tsock with Sys_error _ -> ());
let tfd =
Unix.openfile tout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
in
let tpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-loop.flan"; "-s"; tsock; "--two-process" |]
Unix.stdin tfd Unix.stderr
in
Unix.close tfd;
if not (await (fun () -> Sys.file_exists tsock)) then
fail "--two-process never listened"
else begin
let tc = connect tsock in
let seen = Buffer.create 64 in
let ask q =
let r = Wire.parse (Wire.send tc q; Wire.recv tc) in
(match Wire.string_field r "output" with
| Some t -> Buffer.add_string seen t
| None -> ());
r
in
if status (ask "(:op \"describe\")") <> "ok" then
fail "--two-process: describe was refused";
(* Two processes is the claim here, and it is the opposite one: the pid
launched is the compiler, and the program is a child of it. *)
if Sys.file_exists (Printf.sprintf "/proc/%d/exe" tpid) then begin
match Unix.readlink (Printf.sprintf "/proc/%d/exe" tpid) with
| link when Filename.basename link = "program" ->
fail "--two-process became the program"
| _ | exception Unix.Unix_error _ -> ()
end;
let r =
ask
"(:op \"eval\" :code \"(defn step [] i64 42)\" :file \"/tmp/buf.flan\")"
in
if status r <> "ok" then fail "--two-process: an eval was refused";
if not
(await (fun () ->
ignore (ask "(:op \"describe\")");
contains_sub (Buffer.contents seen) "42"))
then fail "--two-process: the reload was never installed";
ignore (ask "(:op \"close\")");
Unix.close tc
end;
(try Unix.kill tpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] tpid) with Unix.Unix_error _ -> ());
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ tsock; tout ];
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"