flan/test/test_emacs.ml
Joseph Ferano 56395edd59 The Emacs client, and the loop is closed
C-c C-c recompiles the top-level form at point and installs it in a running
program at that program's next frame boundary. Verified against sand: an
unsaved buffer edit to game-draw, and 240 consecutive frames drew it.

flan-mode.el derives from prog-mode with lisp-mode's syntax table, which is
most of the work - Flan is s-expressions, so sexp motion, paren matching,
beginning-of-defun and indentation are already right. What it adds is Flan's
own brackets ([ and { are brackets and not symbol characters, since every
binding list and every type is written with them), the characters a name may
contain, and its keywords.

flan-dev.el has no parser in it, which is what the protocol choice bought:
prin1 writes a request, read reads a reply. C-c C-k sends a buffer as one
module rather than a form at a time, because a defvar and the function using it
have to arrive in the same load or the first refers to storage that does not
exist yet. An error comes back with a location and point moves there.

Framing is in bytes and Emacs counts characters, so every length goes through
string-bytes and the process is binary. Otherwise one non-ASCII character in a
buffer puts the reply stream out of step by exactly as many bytes as the
payload has of them - a bug that reads as a corrupt protocol and only appears
for some people. test_emacs.ml drives the real client against a real daemon for
that reason: it is not the same claim as the daemon answering correctly, and a
mistake in the framing, in beginning-of-defun over Flan's syntax table, or in
the reply reader passes test_dev.ml and fails here.
2026-09-10 22:16:44 +07:00

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-loop.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-loop.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