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:
parent
1a1486a17b
commit
884d6a4d47
@ -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"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user