337 lines
17 KiB
OCaml
337 lines
17 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"
|
|
|
|
(* The counter, the poll, the daemon wait and the connect are all in
|
|
test_support.ml: see its header for why they are not here. *)
|
|
let failures = Test_support.failures
|
|
let fail fmt = Test_support.fail fmt
|
|
let tmp n = Test_support.tmp "flan-repl-" n
|
|
let listen_why = Test_support.listen_why
|
|
let listening = Test_support.listening
|
|
let connect = Test_support.connect
|
|
|
|
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>"
|
|
|
|
(* [Wire.quote] itself, not a copy of it: the escaping the daemon's own
|
|
replies are written with is the escaping a request has to be written with,
|
|
and the case below named "every string escape survives the printer and the
|
|
wire" is checking exactly that function's stated ground. *)
|
|
let quote = Wire.quote
|
|
|
|
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 ~ms:8000 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\")" "()";
|
|
(* A macro, over the socket. [Parse.expr] ran no expander at all until
|
|
now, so this was an unknown name — the prelude's macros included,
|
|
which is what said the gap was older than importable macros. [clamp]
|
|
is a prelude [defmacro] and [unless] is the one that stopped being a
|
|
special form, so between them they cover both shapes: one that
|
|
answers a value and one that answers unit. *)
|
|
value "a prelude macro" "(clamp 9 0 3)" "3";
|
|
value "a prelude macro for its effect" "(unless false 1 2)" "()";
|
|
(* And the buffer's own, which is the set nobody held. [Macro.program]
|
|
collects macros by scanning the forms it is handed and an evaluation
|
|
hands it one form, so [tenfold] — declared in printers.flan, a few
|
|
lines above [main] — was an unknown name in its own file while the
|
|
prelude's and an import's both worked. The session seeds it from the
|
|
same read that built the program. Over a real socket, because that is
|
|
the path a person is on; test_session has the in-process halves. *)
|
|
value "the file's own macro" "(tenfold 7)" "70";
|
|
|
|
(* 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
|
|
(* A declaration is refused by name. It used to come back as "unknown
|
|
name defonce", which is why the reason asserted here was empty; now
|
|
that an expression expands, a macro can produce one, and the head
|
|
says what it is wherever it appears. *)
|
|
refuses "a declaration" "(defonce nope i64)" "cannot be used as an expression here";
|
|
refuses "a declaration inside an expression" "(do 1 (defn f [] i32 1))"
|
|
"cannot be used as an expression here";
|
|
refuses "an unknown name" "no-such-name" "unknown name";
|
|
(* [defmacro] is in that same head list, and it is the shape that stays
|
|
refused now that a [defmacro] typed at the editor means something: a
|
|
person will reach for C-x C-e on one by reflex, and what they get is
|
|
the sentence naming it a declaration rather than an arity complaint
|
|
about an unknown function. C-c C-c is where a declaration goes, which
|
|
is the case below. *)
|
|
refuses "a defmacro at C-x C-e" "(defmacro m [& args] args)"
|
|
"cannot be used as an expression here";
|
|
|
|
(* 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);
|
|
|
|
(* Below the line above deliberately, because this one *does* change the
|
|
session: a macro the file never had, typed at the editor and then
|
|
called. It is the shape the fix chose — a [defmacro] evaluated into a
|
|
session joins it, exactly as a [defn] does, and the next evaluation
|
|
can call it. Two round trips, because that is the whole of the
|
|
claim. *)
|
|
(let r =
|
|
request c
|
|
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote "(defmacro thrice [& args] `(* ~(at args 0) 3))"))
|
|
in
|
|
if status r <> "ok" then
|
|
fail "evaluating a defmacro over the socket: %s"
|
|
(Option.value ~default:(status r) (field r "message")));
|
|
value "a macro defined at the editor" "(thrice 14)" "42";
|
|
|
|
(* ── C-c C-m over the socket ────────────────────────────────────
|
|
[test_session] drives the expansion itself and is where the cases
|
|
live; this is the same question asked the way a person asks it, and
|
|
what it adds is the daemon: the reply's fields, the pretty text
|
|
surviving the framing, and — the part worth a socket — that a request
|
|
which compiles a macro module and refuses it comes back as a reply
|
|
rather than as a daemon that stopped answering.
|
|
|
|
The macro set here is [printers.flan]'s, so it covers the prelude's
|
|
and the buffer's own; the imported-package half is [test_session]'s,
|
|
over [pkg-macro.flan]. *)
|
|
let expands ?(all = false) name code want =
|
|
let r =
|
|
request c
|
|
(Printf.sprintf
|
|
"(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\" :all %s)"
|
|
(quote code) (if all then "t" else "nil"))
|
|
in
|
|
match field r "flat" with
|
|
| Some v when v = want -> ()
|
|
| Some v -> fail "%s\n got: %S\n wanted: %S" name v want
|
|
| None ->
|
|
fail "%s: %s" name (Option.value ~default:(status r) (field r "message"))
|
|
in
|
|
expands "a prelude macro, expanded" "(clamp 9 0 3)" "(min 3 (max 0 9))";
|
|
expands "the file's own macro, expanded" "(tenfold 7)" "(* 7 10)";
|
|
(* And the one typed at the editor a moment ago, which is the session's
|
|
set rather than the file's: nothing on disk declares [thrice]. *)
|
|
expands "a macro defined at the editor, expanded" "(thrice 14)" "(* 14 3)";
|
|
(* Every escape the reader knows, through the printer and then through
|
|
the wire, and back out as the same text. This is the one field in the
|
|
protocol that carries arbitrary literal data — a macro may build any
|
|
literal at all, which is why [Form.to_source] exists beside
|
|
[Form.to_string] — and [Wire.quote] escapes only the quote and the
|
|
backslash, on the stated ground that both readers take everything
|
|
else as itself. This is that ground, checked. *)
|
|
expands "every string escape survives the printer and the wire"
|
|
"\"a\\nb\\0c\\\"d\\\\e\\tf\\rg\"" "\"a\\nb\\0c\\\"d\\\\e\\tf\\rg\"";
|
|
(* And the byte literals, where [to_string] would have written a NUL and
|
|
a carriage return into the middle of the line. *)
|
|
expands "a byte literal is written as a name the reader has"
|
|
"[\\nul \\return \\space \\tab \\newline \\A]"
|
|
"[\\nul \\return \\space \\tab \\newline \\A]";
|
|
(* A float that is a whole number, which [to_string]'s %g writes as an
|
|
integer — and an integer is what it would read back as. *)
|
|
expands "a whole float keeps its point" "[1.0 0.5 -2.0]" "[1.0 0.5 -2.0]";
|
|
|
|
(* A form with no macro in it comes back as itself, and says so rather
|
|
than echoing and leaving the editor to diff. *)
|
|
(let r =
|
|
request c
|
|
(Printf.sprintf
|
|
"(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote "(+ 1 2)"))
|
|
in
|
|
(* [:expanded] is a flag and therefore a symbol, not a string — the
|
|
spelling [:stopped] and [:overflow] already use — so it is read out
|
|
of the form rather than through [Wire.string_field]. *)
|
|
let flag k =
|
|
match Wire.field r k with
|
|
| Some f -> Form.to_source f
|
|
| None -> "<none>"
|
|
in
|
|
if flag "expanded" <> "nil" then
|
|
fail "a form that is not a macro call reported :expanded %s"
|
|
(flag "expanded");
|
|
if field r "note" = None then
|
|
fail "a form that is not a macro call gave no reason");
|
|
(* The name of the macro that ran rides on the reply, because the text
|
|
cannot carry it: [Loc.from_macro] is outermost-wins. *)
|
|
(let r =
|
|
request c
|
|
(Printf.sprintf
|
|
"(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote "(tenfold 7)"))
|
|
in
|
|
if field r "macro" <> Some "tenfold" then
|
|
fail "the reply named %s as the macro that ran"
|
|
(Option.value ~default:"<none>" (field r "macro")));
|
|
(* :text is the same expansion with the line breaks in it. Nothing here
|
|
asserts where they go — that is [Form.pretty]'s and the editor's — only
|
|
that the field is there and reads back as the same form. *)
|
|
(let r =
|
|
request c
|
|
(Printf.sprintf
|
|
"(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote "(tenfold 7)"))
|
|
in
|
|
match field r "text" with
|
|
| Some t when t = "(* 7 10)" -> ()
|
|
| Some t -> fail ":text was %S" t
|
|
| None -> fail ":text was missing");
|
|
(* And the session is untouched by having been asked: a [defmacro] handed
|
|
to C-c C-m does not join it. C-c C-c is where a declaration goes, and
|
|
the round trip below is the only way to check the aftermath. *)
|
|
ignore
|
|
(request c
|
|
(Printf.sprintf
|
|
"(:op \"macroexpand\" :code %s :file \"/tmp/buf.flan\")"
|
|
(quote "(defmacro looked-at [& args] `(* ~(at args 0) 5))")));
|
|
(let r = evals "(looked-at 3)" in
|
|
if status r = "ok" then
|
|
fail "a defmacro joined the session by being macroexpanded");
|
|
|
|
ignore (request c "(:op \"close\")");
|
|
Unix.close c
|
|
end;
|
|
(* Asked before it is told: a daemon that has already died says so in its
|
|
wait status, and that is the difference between "the test's last request
|
|
was wrong" and "the session was not there to ask". The kill below then
|
|
has nothing to do. See test_emacs.ml, where this was the fact two
|
|
diagnoses of the same flake were missing. *)
|
|
let died =
|
|
match Unix.waitpid [ Unix.WNOHANG ] pid with
|
|
| 0, _ ->
|
|
(try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
|
|
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
|
|
None
|
|
| _, st -> Some st
|
|
| exception Unix.Unix_error _ -> None
|
|
in
|
|
(* Read before the removal, because on a failure this is the evidence. *)
|
|
let prog_out =
|
|
if !failures = 0 then ""
|
|
else
|
|
match open_in_bin out 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
|
|
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;
|
|
(match died with
|
|
| Some (Unix.WEXITED n) ->
|
|
Printf.printf "the daemon had already exited with status %d\n" n
|
|
| Some (Unix.WSIGNALED n) when n = Sys.sigpipe ->
|
|
print_endline
|
|
"the daemon had already been killed by SIGPIPE — a reply written \
|
|
into a socket whose reader had gone"
|
|
| Some (Unix.WSIGNALED n) ->
|
|
Printf.printf "the daemon had already been killed by signal %d\n" n
|
|
| Some (Unix.WSTOPPED n) ->
|
|
Printf.printf "the daemon was stopped on signal %d\n" n
|
|
| None -> print_endline "the daemon was still running at the end");
|
|
Printf.printf "\n-- the program's own output, last 4k --\n%s\n" prog_out;
|
|
exit 1
|
|
end
|
|
| _ -> print_endline "repl: skipped (no clang or llc on PATH)"
|