76270eac0d
Ten test binaries share a directory and had shared nothing in it but watchdog.ml. Everything else each one needed it wrote out again: the failure counter and its FAIL line, the three-line report tail, a poll, a socket connect, the wait for a [flan dev] daemon to bind, a substring search, and the Load -> Check -> Reach.link front half of a compile. [listening] was the clearest case. Three copies, byte for byte apart from one comment, and two of them said in that comment that they were kept separate because "these three files have no module between them". That was not true when it was written: watchdog.ml was already named in the same (modules ...) stanzas. test_support.ml is the second such module, wired the same way, and those two sentences go with the copies they were explaining. test_repl.ml's [quote] was Wire.quote character for character, in a file that already links Wire and already names Wire.quote in a comment about what the case below it is checking. It is Wire.quote now. One real behaviour change, and it is a fix. [connect] existed twice over with different retries: the agent's narrowed to ECONNREFUSED with a comment saying why -- the socket file appears at bind, a moment before listen -- while dev's and repl's retried any Unix_error, which meant an ENOENT or an EACCES was retried to the full timeout before raising something the reader still had to interpret. The shared one takes the narrow version. Every caller connects to a socket [listening] has already seen on disk, so the race it does catch is the only one left. The rest is left where it is, on purpose. The three output-capturing [run]s differ in what they wrap -- a pid suffix, a sanitizer environment, a valgrind invocation -- and are not the same function. The report tails in test_repl, test_web and the two sweep binaries print different things for different reasons. The per-file scratch prefixes are the feature that keeps two suites running at once from unlinking each other's sockets, so the shared helper takes the prefix rather than choosing one. And the [match Sys.command "command -v clang ..."] probes stay as they are: their skip lines are output this suite pins. bin/main.ml has the compile pipeline written out twice more. Left alone -- this was a test/-scoped change and bin/ should not be reaching into a test module -- and noted in FIX.org as what it actually needs, which is the pipeline moving into lib/. dune test: exit 0, and its output is the same line for line once the temp-directory hash and the millisecond counts are normalised.
337 lines
16 KiB
OCaml
337 lines
16 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 defvar", 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" "(defvar nope i64)" "top-level declaration";
|
|
refuses "a declaration inside an expression" "(do 1 (defn f [] i32 1))"
|
|
"top-level declaration";
|
|
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)"
|
|
"top-level declaration";
|
|
|
|
(* 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)"
|