Joseph Ferano
7ce1d09900
A different primitive from redefining a name. There is no name to install a body into, so the expression is wrapped in a function with nowhere to be called from; the module exports flan_reload_call to say "run this once", and the agent calls it after the install - on the game thread, at a frame boundary, so an expression that reads the program's state sees a point the program agrees is consistent. Nothing is marshalled back because nothing could be. A Flan value carries no header, so no code at run time can say what it is; the compiler knows the type and renders it there, in the thunk. That is the layout decision's bill, and it is why the printer set is the scalars rather than everything. The rendering does not go through stdout. Stdout belongs to the program, it is in the hot path for anything that prints, and a dev-only feature must not put a branch in it - so flan_rt.c is untouched and the value goes to flan_dev_result, read back over the agent's socket. Safe without a handshake because the generation counter is bumped last: the daemon waits for it to move rather than assuming the program has reached a frame boundary. u64 refuses by name, because i64->bytes is signed and anything past 2^63 would come back negative. Everything without a derived printer refuses the same way. A number that is quietly wrong is the failure this whole thing exists to prevent. An evaluation is not a declaration: the thunk is built against the program and never spliced into it, so describe does not fill up with an eval/N for every expression ever typed. The test that matters is the same expression twice. The fixture increments ticks every frame, so two evaluations must disagree - a value computed in the compiler, or read from a copy of the program's state, would not.
142 lines
6.2 KiB
OCaml
142 lines
6.2 KiB
OCaml
(* [flan dev]: the daemon an editor talks to (NEXT.md, the dev loop).
|
|
|
|
What it adds over [flan reload] is that the session persists between
|
|
evaluations and that the daemon owns the build, so its idea of the running
|
|
process is not a guess. Both are tested here by sending a sequence: a name
|
|
the program was never built with, then a second evaluation that uses it. If
|
|
the session were rebuilt per request the second one would not even check. *)
|
|
|
|
open Flan
|
|
|
|
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-devtest-" ^ n)
|
|
|
|
let rec await ?(ms = 5000) 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 rec connect ?(ms = 5000) 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 status r =
|
|
match Wire.string_field r "status" with Some s -> s | None -> "<none>"
|
|
|
|
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" in
|
|
let out = tmp "prog.out" in
|
|
(try Sys.remove sock with Sys_error _ -> ());
|
|
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
|
(* The daemon is run as a subprocess rather than in-process because that is
|
|
how an editor meets it, and because it launches and owns a program of
|
|
its own. Its child's stdout is what we read the result off. *)
|
|
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
|
|
fail "the daemon never listened"
|
|
else begin
|
|
(* The daemon owns the program's lifetime and kills it on [close], so
|
|
every step waits for the program to have got there. "ok" from an eval
|
|
means the module was queued, not that it has been installed. *)
|
|
let lines () =
|
|
List.length
|
|
(String.split_on_char '\n'
|
|
(In_channel.with_open_bin out In_channel.input_all))
|
|
- 1
|
|
in
|
|
let c = connect sock in
|
|
|
|
(* describe: what the daemon believes about the program it launched. *)
|
|
let r = request c "(:op \"describe\")" in
|
|
if status r <> "ok" then fail "describe: %s" (status r);
|
|
|
|
(* A form that does not check comes back as an error with a location,
|
|
and must not disturb the session. *)
|
|
let r = request c "(:op \"eval\" :code \"(defn step [] i64 nonsense)\" :file \"/tmp/buf.flan\")" in
|
|
if status r <> "error" then fail "a bad form was accepted";
|
|
(match Wire.string_field r "loc" with
|
|
| Some l when String.length l > 0 -> ()
|
|
| _ -> fail "an error carried no location");
|
|
|
|
(* A name the program was never built with, then a second evaluation
|
|
that uses it. The second one only checks at all because the session
|
|
kept the first. *)
|
|
let r =
|
|
request c
|
|
"(:op \"eval\" :code \"(defvar extra i64) (defn step [] i64 (set extra (+ extra 5)) extra)\" :file \"/tmp/buf.flan\")"
|
|
in
|
|
if status r <> "ok" then
|
|
fail "adding a var: %s"
|
|
(Option.value ~default:"" (Wire.string_field r "message"));
|
|
(* Wait for the program to have installed it before sending the next.
|
|
Both queued at once is a legitimate thing for the agent to do — one
|
|
poll installs everything pending — but then only the last is observed
|
|
and the sequencing is not what was tested. *)
|
|
if not (await (fun () -> lines () >= 2)) then
|
|
fail "the first reload was never installed";
|
|
let r =
|
|
request c
|
|
"(:op \"eval\" :code \"(defn step [] i64 (set extra (+ extra 100)) extra)\" :file \"/tmp/buf.flan\")"
|
|
in
|
|
if status r <> "ok" then
|
|
fail "reusing a var added earlier: %s"
|
|
(Option.value ~default:"" (Wire.string_field r "message"));
|
|
|
|
(* A change the running process cannot be told, refused with the reason
|
|
rather than delivered. *)
|
|
let r = request c "(:op \"eval\" :code \"(defvar ticks i32)\" :file \"/tmp/buf.flan\")" in
|
|
if status r <> "error"
|
|
|| not
|
|
(match Wire.string_field r "message" with
|
|
| Some m -> String.length m > 0
|
|
| None -> false)
|
|
then fail "retyping a global was not refused";
|
|
|
|
if not (await (fun () -> lines () >= 3)) then
|
|
fail "the second reload was never installed";
|
|
|
|
(* Expression evaluation, which is a different primitive: no name to
|
|
install a body into, so a thunk runs at a frame boundary and the value
|
|
comes back rendered. The program has stopped reaching frame boundaries
|
|
by now, so this only checks that the types that have no printer say so
|
|
rather than guessing — the live path is test_repl. *)
|
|
let r = request c "(:op \"eval-expr\" :code \"(defvar x i64)\" :file \"/tmp/buf.flan\")" in
|
|
if status r <> "error" then fail "a declaration was accepted as an expression";
|
|
ignore (request c "(:op \"close\")");
|
|
Unix.close c;
|
|
(* Closing the connection ends the program, and its transcript is the
|
|
proof: 1 before any reload, 5 from a body over a var that did not
|
|
exist when it started, 105 from a second body reading the same one. *)
|
|
ignore (Unix.waitpid [] pid);
|
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
|
if text <> "1\n5\n105\n" then
|
|
fail "program transcript\n got: %S\n wanted: %S" text "1\n5\n105\n"
|
|
end;
|
|
|
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
|
|
if !failures = 0 then print_endline "dev: all tests passed"
|
|
else begin
|
|
Printf.printf "\n%d failure(s)\n" !failures;
|
|
exit 1
|
|
end
|
|
| _ -> print_endline "dev: skipped (no clang or llc on PATH)"
|