Joseph Ferano
f2be0a62dd
Two follow-ups to the marking commit. `Dev.eval_expr`'s new wait matched `Stopped _`, which fires on the first iteration when the program is already parked on something else — the break loop allows evaluating, so that is reachable — and answers for a thunk that has not run yet, on a reply whose own `:condition` names the other condition. It now waits for `Stopped "Pause"`, which the agent reports under a nested break because `condition_name` is overwritten on the way in and restored on the way out. `dev-pause.flan` grows a `Missing` and a `boom` so the test can park the program on something else first and tell the two apart. And the flake NEXT.md had as "seen once and unexplained": `the daemon never listened` is not a race, it is an llc-and-link of the whole program before `flan dev` binds — ~600ms idle, measured at 6.6s and 6.8s with the rest of the suite beside it, against a 5s and 8s await. All three test binaries now wait a minute; the watchdog is what bounds the run. Two consecutive full runs green.
97 lines
4.4 KiB
OCaml
97 lines
4.4 KiB
OCaml
(* The Emacs client, against a real daemon and a real running program.
|
|
|
|
test_dev.ml proves the daemon answers correctly. This proves the elisp
|
|
actually talks to it, which is not the same claim: the framing is in bytes
|
|
and Emacs counts characters, `beginning-of-defun' has to find a Flan
|
|
top-level form through Flan's own syntax table, and a reply is read with
|
|
`read'. A mistake in any of those passes the OCaml test and fails here.
|
|
|
|
Skipped, not failed, where there is no emacs — the compiler does not depend
|
|
on one. *)
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports
|
|
nothing at all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_emacs"
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
let tmp n = Filename.concat scratch ("flan-emacs-" ^ n)
|
|
|
|
let rec await ?(ms = 8000) f =
|
|
if f () then true
|
|
else if ms <= 0 then false
|
|
else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end
|
|
|
|
let () =
|
|
let have cmd = Sys.command (Printf.sprintf "command -v %s > /dev/null 2>&1" cmd) = 0 in
|
|
if not (have "emacs") then print_endline "emacs: skipped (no emacs on PATH)"
|
|
else if not (have "clang" && have "llc") then
|
|
print_endline "emacs: skipped (no clang or llc on PATH)"
|
|
else begin
|
|
let sock = tmp "dev.sock" and out = tmp "prog.out" in
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
|
|
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
|
let flan = "../bin/main.exe" in
|
|
(* Absolute, because the client starts its own daemon at the end of the run
|
|
and does it from the program's directory rather than from this one. *)
|
|
let flan_abs = try Unix.realpath flan with Unix.Unix_error _ -> flan in
|
|
(* And the program itself, for the same reason: the client starts a daemon
|
|
of its own at the end of the run, and the copy it edits is in a
|
|
temporary directory with no package collections above it. *)
|
|
let program =
|
|
let p = "programs/dev-repl.flan" in
|
|
try Unix.realpath p with Unix.Unix_error _ -> p
|
|
in
|
|
let pid =
|
|
Unix.create_process flan
|
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
|
|
Unix.stdin fd Unix.stderr
|
|
in
|
|
Unix.close fd;
|
|
(* A minute, not the 8s default: what is being waited for is not a socket
|
|
but an llc-and-link of the whole program, which has been measured at
|
|
6.8s with this suite's other binaries running beside it under dune's own
|
|
parallelism. It only has to be long enough that a failure here means the
|
|
daemon is not coming; the watchdog is what bounds the run. *)
|
|
if not (await ~ms:60000 (fun () -> Sys.file_exists sock)) then begin
|
|
print_endline "FAIL the daemon never listened";
|
|
(try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
|
|
exit 1
|
|
end;
|
|
(* A copy, because the test edits the buffer it sends from. Removed first
|
|
and made writable after: the original comes out of a build directory
|
|
read-only, so copying onto a leftover copy would fail and leave the old
|
|
one in place. *)
|
|
let buf = tmp "buf.flan" in
|
|
(try Sys.remove buf with Sys_error _ -> ());
|
|
ignore
|
|
(Sys.command
|
|
(Printf.sprintf "cp %s %s" (Filename.quote "programs/dev-repl.flan")
|
|
(Filename.quote buf)));
|
|
(try Unix.chmod buf 0o644 with Unix.Unix_error _ -> ());
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf
|
|
"emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el \
|
|
-- %s %s %s %s 2>&1"
|
|
(Filename.quote sock) (Filename.quote buf) (Filename.quote flan_abs)
|
|
(Filename.quote program))
|
|
in
|
|
(* The client disconnects at the end, which is what ends the daemon. If it
|
|
did not get that far — because it failed — nothing else will, so it is
|
|
stopped here rather than left waiting on a socket nobody will use. *)
|
|
if not (await ~ms:3000 (fun () ->
|
|
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
|
| 0, _ -> false
|
|
| _ -> true
|
|
| exception Unix.Unix_error _ -> true))
|
|
then begin
|
|
(try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
|
|
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
|
|
end;
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; buf ];
|
|
if code = 0 then print_endline "emacs: all tests passed"
|
|
else begin
|
|
Printf.printf "\nemacs client exited %d\n" code;
|
|
exit 1
|
|
end
|
|
end
|