217 lines
10 KiB
OCaml
217 lines
10 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"
|
|
(* The scratch paths, the poll and the daemon wait are in test_support.ml. The
|
|
long note on what [listening] can and cannot tell apart is there with it. *)
|
|
let tmp n = Test_support.tmp "flan-emacs-" n
|
|
let await = Test_support.await
|
|
let listen_why = Test_support.listen_why
|
|
let listening = Test_support.listening
|
|
|
|
let () =
|
|
let have = Test_support.have 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" and err = tmp "dev.err" in
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; err ];
|
|
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
|
(* The daemon's stderr to a file rather than inherited: it carries the
|
|
"ready on" line and any OCaml backtrace, and a failure here wants both
|
|
quoted next to the client's complaint rather than interleaved with
|
|
whatever else dune was running. *)
|
|
let efd = Unix.openfile err [ 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
|
|
(* [--llvm], and it is not incidental: this suite drives the inspector --
|
|
backtrace, locals, globals -- and those are frames on the dev shadow
|
|
stack, which [lib/x86.ml] does not push. The default backend for [flan
|
|
dev] is x86 now, so a flagless daemon here would answer every one of
|
|
those with the refusal naming this flag, and the client half of the
|
|
break protocol would go untested. The client's own daemon at the end of
|
|
the run asks for it through [flan-daemon-args] for the same reason,
|
|
which is also where that setting is proved to reach a command line. *)
|
|
let pid =
|
|
Unix.create_process flan
|
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock; "--llvm" |]
|
|
Unix.stdin fd efd
|
|
in
|
|
Unix.close fd;
|
|
Unix.close efd;
|
|
(* Thirty seconds and not the 8s default: this waits on an llc-and-link of
|
|
the whole program, ~0.5s warm and 2s cold, worst measured at 6.8s with
|
|
this suite's other binaries running beside it. The watchdog bounds the
|
|
run; a crash no longer waits for either. *)
|
|
if not (listening ~pid sock) then begin
|
|
print_endline ("FAIL the daemon " ^ !listen_why);
|
|
(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.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.
|
|
|
|
The wait *status* is kept, and not thrown away as it used to be, because
|
|
it is the one fact that tells the two failure shapes apart. A daemon
|
|
that exited on its own runs its cleanup and unlinks the socket, and the
|
|
client then says "nothing is listening"; a daemon killed by a signal
|
|
never gets that far, leaves the socket file behind, and the client gets
|
|
an ECONNREFUSED it cannot explain. Two diagnoses of this flake have
|
|
already been wrong for want of this line. *)
|
|
let status = ref None in
|
|
if not (await ~ms:3000 (fun () ->
|
|
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
|
| 0, _ -> false
|
|
| _, st -> status := Some st; 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;
|
|
let how =
|
|
match !status with
|
|
| Some (Unix.WEXITED n) -> Printf.sprintf "exited with status %d" n
|
|
| Some (Unix.WSIGNALED n) ->
|
|
Printf.sprintf "was killed by %s — nothing ran its cleanup, so \
|
|
the socket file is stale rather than gone"
|
|
(Test_support.signal_name n)
|
|
| Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on %s" (Test_support.signal_name n)
|
|
| None -> "was still running when the client finished, and was terminated"
|
|
in
|
|
(* Read before the removal below, because on a failure this is the evidence
|
|
and the removal is what destroyed it last time. *)
|
|
let tail_of path =
|
|
match open_in_bin path with
|
|
| ic ->
|
|
let n = in_channel_length ic in
|
|
let want = min n 4000 in
|
|
seek_in ic (n - want);
|
|
let s = really_input_string ic want in
|
|
close_in ic;
|
|
s
|
|
| exception Sys_error _ -> "<no such file>"
|
|
in
|
|
let sock_left = Sys.file_exists sock in
|
|
let prog_out = if code = 0 then "" else tail_of out in
|
|
let daemon_err = if code = 0 then "" else tail_of err in
|
|
List.iter
|
|
(fun f -> try Sys.remove f with Sys_error _ -> ())
|
|
[ sock; out; err; buf ];
|
|
if code = 0 then print_endline "emacs: all tests passed"
|
|
else begin
|
|
Printf.printf "\nemacs client exited %d\n" code;
|
|
Printf.printf "the daemon %s\n" how;
|
|
Printf.printf "%s was %s after the run\n" sock
|
|
(if sock_left then "still there" else "gone");
|
|
Printf.printf "\n-- the program's own output, last 4k --\n%s\n" prog_out;
|
|
Printf.printf "\n-- the daemon's stderr, last 4k --\n%s\n" daemon_err;
|
|
exit 1
|
|
end
|
|
end
|
|
|
|
(* A socket path longer than a unix socket address holds, which Emacs cannot
|
|
connect to by name: the daemon links it at a short path, the client
|
|
computes the same one, and the link goes when the session is closed. *)
|
|
let () =
|
|
let have = Test_support.have in
|
|
if have "emacs" && have "clang" && have "llc" then begin
|
|
let deep =
|
|
Filename.concat Test_support.scratch
|
|
(String.make (max 1 (110 - String.length Test_support.scratch)) 'd')
|
|
in
|
|
Unix.mkdir deep 0o700;
|
|
let sock = Filename.concat deep "an-editor-socket-past-the-limit.sock"
|
|
and err = tmp "long.err" in
|
|
let efd = Unix.openfile err [ 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-pause.flan"; "-s"; sock |]
|
|
Unix.stdin efd efd
|
|
in
|
|
Unix.close efd;
|
|
let short = Flan.Wire.short_socket_path sock in
|
|
let failed = ref false in
|
|
let fail fmt =
|
|
Printf.ksprintf (fun s -> failed := true; print_endline ("FAIL " ^ s)) fmt
|
|
in
|
|
if not (listening ~pid sock) then fail "the long-socket daemon %s" !listen_why
|
|
else begin
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf
|
|
"emacs -Q --batch -L ../../../emacs -l flan --eval %s 2>&1"
|
|
(Filename.quote
|
|
(Printf.sprintf
|
|
"(progn (flan--open %S) \
|
|
(flan--send flan--connection '(:op \"describe\")) \
|
|
(let ((r (flan--read-reply flan--connection))) \
|
|
(flan--send flan--connection '(:op \"close\")) \
|
|
(ignore-errors (flan--read-reply flan--connection)) \
|
|
(delete-process flan--connection) \
|
|
(kill-emacs (if (equal (plist-get r :status) \"ok\") 0 1))))"
|
|
sock)))
|
|
in
|
|
if code <> 0 then
|
|
fail "emacs could not talk to a daemon on a %d-byte socket path \
|
|
(exit %d; daemon: %s)" (String.length sock) code
|
|
(In_channel.with_open_bin err In_channel.input_all)
|
|
end;
|
|
if not (await ~ms:5000 (fun () ->
|
|
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
|
| 0, _ -> false
|
|
| _ -> true
|
|
| exception Unix.Unix_error _ -> true))
|
|
then begin
|
|
(try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
|
|
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
|
|
fail "the long-socket daemon did not end when the client left"
|
|
end
|
|
else if (try ignore (Unix.lstat short); true with Unix.Unix_error _ -> false)
|
|
then fail "the short link %s was left after a clean end" short;
|
|
(try Unix.unlink short with Unix.Unix_error _ -> ());
|
|
(try Sys.remove err with Sys_error _ -> ());
|
|
Own_tmp.remove deep;
|
|
if !failed then exit 1 else print_endline "emacs: a long socket path connects"
|
|
end
|