Joseph Ferano
8a94f16acd
Its stdout is a pipe into the daemon now, and whatever it printed since the last reply rides along with the next one into *flan-output*. Arriving with a reply rather than by a separate request is the point: the output an evaluation itself caused is the output anyone wants to see. Draining that pipe is a liveness requirement, not a nicety. A pipe nobody reads fills at 64K and the next write blocks the program forever, so it is read from the accept loop's select whether or not an editor is asking, and the buffer is capped - a program printing every frame must not grow the daemon without limit, and the newest text is the useful end. test_dev read the program's transcript off the daemon's stdout, which is no longer where it goes; it collects :output from replies instead, which is also what the editor does. The emacs test moved to a fixture that keeps running, since it now evaluates more times than the old one had reloads to give.
77 lines
3.3 KiB
OCaml
77 lines
3.3 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. *)
|
|
|
|
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
|
|
let pid =
|
|
Unix.create_process flan
|
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
|
|
Unix.stdin fd Unix.stderr
|
|
in
|
|
Unix.close fd;
|
|
if not (await (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 2>&1"
|
|
(Filename.quote sock) (Filename.quote buf))
|
|
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
|