Joseph Ferano
a4c6b996ff
The trio the author decided on 2026-09-20 is now all built: def is CL's defparameter — its initialiser runs on every daemon re-run, unguarded, so an edited initialiser repaints the same storage on C-c C-c plus re-run — defonce (Clojure's name for CL's defvar, per the author) initialises once behind the .init~once. flag, and defconst stays the image. One parse arm reads both forms; the difference is Ast.reinit, carried to Tast.global's grerun. Emit.startup_plan gives a def no guard flag, and Check.check_global lifts every def initialiser — zero and literal included — into global/<n>, so the host's startup reaches it through the function cell and a re-evaluated def swaps it (Session's def_inits; Emit.redefinition declares the cell for a non-sibling target). The old defvar spelling is refused with the rename and both compiling spellings, and every program, test, doc and editor list is swept — except sand.flan, the author's live WIP, whose seven defvar lines are flagged in FIX.org and keep its three dependent tests red on this branch.
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 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)" "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)"
|