Joseph Ferano
0a6199b8df
FLAN_CLANG=/bin/false against test_repl: 'the daemon exited with status 2 before binding /tmp/flan-repl-dev.sock' in 45ms, where the old wording would have waited out the whole timer and then blamed the socket.
201 lines
8.4 KiB
OCaml
201 lines
8.4 KiB
OCaml
(* C-x C-e: evaluating an expression inside a program that is running.
|
|
|
|
A different primitive from redefining a name, and the difference is the
|
|
whole test: there is no name to install a body into, so the expression is
|
|
compiled into a thunk with nowhere to be called from, the module says "run
|
|
this once", and the agent does — at a frame boundary, on the game thread.
|
|
|
|
Nothing is marshalled back. A Flan value carries no header, so nothing at
|
|
run time could say what it is; the compiler knows the type and renders it
|
|
there. That is the layout decision's bill, and it is why only the scalars
|
|
work so far.
|
|
|
|
The case that matters most is the same expression evaluated twice with
|
|
different answers: that is what says it read the live process's state rather
|
|
than a copy of it. *)
|
|
|
|
open Flan
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports
|
|
nothing at all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_repl"
|
|
|
|
let failures = ref 0
|
|
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
|
|
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
let tmp n = Filename.concat scratch ("flan-repl-" ^ 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
|
|
|
|
(* One timer covers two waits here — [flan dev] builds the whole program and
|
|
only then binds — so the failure has to say which of them it was. See
|
|
[listening] in test_dev.ml for the whole of the reasoning; this is the same
|
|
helper, kept here rather than shared because these three files have no
|
|
module between them. Watching the process as well as the socket is what
|
|
makes a crash fail in milliseconds instead of costing the full timeout. *)
|
|
let listen_why = ref ""
|
|
|
|
let listening ?(ms = 30000) ~pid path =
|
|
let died = ref None in
|
|
ignore
|
|
(await ~ms (fun () ->
|
|
Sys.file_exists path
|
|
||
|
|
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
|
| 0, _ -> false
|
|
| _, st -> died := Some st; true
|
|
| exception Unix.Unix_error _ -> false));
|
|
if Sys.file_exists path then true
|
|
else begin
|
|
listen_why :=
|
|
(match !died with
|
|
| Some (Unix.WEXITED n) ->
|
|
Printf.sprintf "exited with status %d before binding %s" n path
|
|
| Some (Unix.WSIGNALED n) ->
|
|
Printf.sprintf "was killed by signal %d before binding %s" n path
|
|
(* Unreachable without WUNTRACED, and here only for exhaustiveness. *)
|
|
| Some (Unix.WSTOPPED n) ->
|
|
Printf.sprintf "stopped on signal %d without binding %s" n path
|
|
| None ->
|
|
Printf.sprintf
|
|
"was still running after %ds without binding %s, so it was the \
|
|
build that did not finish, not the socket"
|
|
(ms / 1000) path);
|
|
false
|
|
end
|
|
|
|
let rec connect ?(ms = 8000) path =
|
|
let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
|
|
match Unix.connect s (Unix.ADDR_UNIX path) with
|
|
| () -> s
|
|
| exception Unix.Unix_error _ when ms > 0 ->
|
|
Unix.close s;
|
|
ignore (Unix.select [] [] [] 0.005);
|
|
connect ~ms:(ms - 5) path
|
|
|
|
let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd)
|
|
let field r k = Wire.string_field r k
|
|
let status r = match field r "status" with Some s -> s | None -> "<none>"
|
|
|
|
let quote s =
|
|
let b = Buffer.create (String.length s + 8) in
|
|
Buffer.add_char b '"';
|
|
String.iter
|
|
(fun c ->
|
|
if c = '"' || c = '\\' then Buffer.add_char b '\\';
|
|
Buffer.add_char b c)
|
|
s;
|
|
Buffer.add_char b '"';
|
|
Buffer.contents b
|
|
|
|
let () =
|
|
match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
|
|
| 0 ->
|
|
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/printers.flan"; "-s"; sock |]
|
|
Unix.stdin fd Unix.stderr
|
|
in
|
|
Unix.close fd;
|
|
(* 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
|
|
fail "the daemon %s" !listen_why
|
|
else begin
|
|
let c = connect sock in
|
|
let evals code =
|
|
request c
|
|
(Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote code))
|
|
in
|
|
let value name code expected =
|
|
let r = evals code in
|
|
match field r "value" with
|
|
| Some v when v = expected -> ()
|
|
| Some v -> fail "%s\n got: %S\n wanted: %S" name v expected
|
|
| None ->
|
|
fail "%s: %s" name (Option.value ~default:(status r) (field r "message"))
|
|
in
|
|
value "arithmetic" "(+ 1 2)" "3";
|
|
value "a comparison" "(< 1 2)" "true";
|
|
(* Quoted and escaped, in the runtime: a string whose content is not
|
|
escaped does not round-trip and reads as a framing bug. *)
|
|
value "a string" "\"hi\"" "\"hi\"";
|
|
value "an escaped string" "(.name b)" "\"sandy \\\"quoted\\\"\"";
|
|
(* A defconst: its value is in the program's memory and this reads it. *)
|
|
value "a constant" "step-by" "3";
|
|
(* Rendered in C, because the language's own i64->bytes is signed and
|
|
this would otherwise come back as -1. *)
|
|
value "u64 at its maximum" "big" "18446744073709551615";
|
|
(* A struct, nested, with a fixed array inside it. *)
|
|
value "a struct" "(.pos b)" "(V {.x 1.5 .y 0})";
|
|
value "a nested struct" "b"
|
|
"(Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y 0}) .tags [ 0 42 0]})";
|
|
value "a fixed array" "arr" "[ 0 0 9 0]";
|
|
(* A slice's length is not known until it runs, so this one renders
|
|
through a loop rather than by unrolling. *)
|
|
value "a slice" "(slice (.tags b) 0 3)" "[ 0 42 0]";
|
|
(* An enum's members are erased to i32 before the backend sees them, so
|
|
the name is recovered from the checker's table. *)
|
|
value "an enum" "col" ":blue";
|
|
(* A Unit expression is almost always a call made for its effect, so it
|
|
has to be *evaluated* and then reported as (). Emitting the literal
|
|
without running it made the prompt answer while nothing happened. *)
|
|
value "a call made for its effect" "(println \"printed\")" "()";
|
|
|
|
(* The one that proves it ran inside the process: the program increments
|
|
[ticks] every frame, so two evaluations of it must disagree. A copy
|
|
of the program's state, or a value computed here, would not. *)
|
|
let read () =
|
|
match field (evals "ticks") "value" with
|
|
| Some v -> int_of_string_opt v
|
|
| None -> None
|
|
in
|
|
(match (read (), read ()) with
|
|
| Some a, Some b when b > a -> ()
|
|
| Some a, Some b ->
|
|
fail "ticks read %d then %d — the expression did not see the live \
|
|
program advancing" a b
|
|
| _ -> fail "ticks did not evaluate");
|
|
|
|
let refuses name code reason =
|
|
let r = evals code in
|
|
match field r "message" with
|
|
| Some m when
|
|
(let n = String.length reason and h = String.length m in
|
|
let rec go i = i + n <= h && (String.sub m i n = reason || go (i + 1)) in
|
|
go 0) -> ()
|
|
| Some m -> fail "%s said %S, wanted it to mention %S" name m reason
|
|
| None -> fail "%s was accepted" name
|
|
in
|
|
refuses "a declaration" "(defvar nope i64)" "";
|
|
refuses "an unknown name" "no-such-name" "unknown name";
|
|
|
|
(* And the session is untouched by all of it: an evaluation is not a
|
|
declaration, so nothing named eval/N accumulates in the program. *)
|
|
let r = request c "(:op \"describe\")" in
|
|
if status r <> "ok" then fail "describe after evaluating: %s" (status r);
|
|
|
|
ignore (request c "(:op \"close\")");
|
|
Unix.close c
|
|
end;
|
|
(try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
|
|
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
|
|
if !failures = 0 then print_endline "repl: all tests passed"
|
|
else begin
|
|
Printf.printf "\n%d failure(s)\n" !failures;
|
|
exit 1
|
|
end
|
|
| _ -> print_endline "repl: skipped (no clang or llc on PATH)"
|