diff --git a/NEXT.md b/NEXT.md index 1c760c2..14f5e55 100644 --- a/NEXT.md +++ b/NEXT.md @@ -484,10 +484,18 @@ blocks on the loader. `wait` exists for tests. A test that races the frame rate fails on a loaded machine, so `test/programs/agent.flan` waits for the reload instead of sleeping -past it. +past it. It takes **two** reloads, which is the daemon's actual loop: the first +introduces a global the process was never built with, the second only reads it, +and the second can only answer 1007 if it found the storage the first one +allocated rather than a fresh zeroed copy. One reload would not have shown +that. Two details found by running it: +- **stdout is line buffered**, set in `flan_rt_init`. The C default when + stdout is a file or a pipe is a 4K block, so a program running with a REPL + attached shows nothing until it exits — and a test driving one cannot see + its progress at all, which is how this was found. - **The reply goes out before the module is queued.** The other way round, the game thread can install and the program can exit between the two, and the answer reaches the sender as a connection reset rather than as `ok`. @@ -550,6 +558,14 @@ session over the program the process was built from, and a file of the forms that changed. Verified against a running sand under Xvfb — a one-form `game-draw` and 910 consecutive frames drew it. +Two limits of that command specifically, neither of them true of sessions: +it builds a fresh session from source on every invocation, so if the program +file has been edited since the process launched, its idea of which names the +host has and what its memory looks like describes a binary that is not running. +And `Session.eval`'s `origin` defaults to ``, so an error in forms sent +without one reports positions in a file that does not exist — the daemon has to +pass the real buffer path, which is the same key CIDER's `eval` carries. + ### What is left `C-c C-c` works end to end today; what is missing is the two hops between an diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index fef67da..50b61e8 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -26,6 +26,12 @@ static flan_slice *rt_args; /* argv as [string], built once, never freed */ void flan_rt_init(int32_t argc, char **argv) { rt_argc = (int)argc; rt_argv = argv; + /* Line buffered even when stdout is a file or a pipe, where the C default is + * a 4K block. A Flan program can run for minutes with a REPL attached to it, + * and output that only appears when it exits is output nobody can use. It is + * also what makes a program's progress observable to a test that is driving + * it. The cost is one write per line instead of per 4K. */ + setvbuf(stdout, NULL, _IOLBF, 0); } void flan_argv(flan_slice *out) { diff --git a/test/programs/agent.flan b/test/programs/agent.flan index 73e65f8..91d1ad2 100644 --- a/test/programs/agent.flan +++ b/test/programs/agent.flan @@ -1,9 +1,11 @@ ;;;; The agent, end to end: a running program takes a redefinition over a ;;;; socket and installs it between "frames". ;;;; -;;;; [tick] is the function that gets redefined. It is called once before the -;;;; reload and once after, and nothing else in this file changes, so the two -;;;; numbers are the whole result. +;;;; [tick] is the function that gets redefined. It is called once before any +;;;; reload and once after each of two of them, and nothing else in this file +;;;; changes, so the three numbers are the whole result. Two reloads and not +;;;; one because that is the daemon's actual loop: a second module built from +;;;; the same session, reading state the first one introduced. ;;;; ;;;; It waits rather than polling on a timer because a test that races the ;;;; frame rate is a test that fails on a loaded machine. A game loop calls @@ -24,6 +26,8 @@ (if (< (agent/start (at args 1)) 0) (do (print-line "cannot listen") 1) (do + (print-i64 (tick)) (newline) + (while (= (agent/wait 100) 0) 0) (print-i64 (tick)) (newline) (while (= (agent/wait 100) 0) 0) (print-i64 (tick)) (newline) diff --git a/test/test_agent.ml b/test/test_agent.ml index a85b1bf..8bcb818 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -77,10 +77,25 @@ let () = (Build.executable ~opts:dev ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags t.Session.host ~out:exe); - (* One form, which is what C-c C-c sends. *) - let c = Session.eval t "(defn tick [] i64 (set ticks (+ ticks 1000)) ticks)" in - let so = tmp "tick.so" in - ignore (Build.shared ~opts:dev ~ir:c.Session.ir ~out:so ()); + (* Two evaluations from the one session, which is the daemon's loop and + the thing no earlier test does. The first introduces a global the + process was never built with; the second only reads it, and can only + come back with 1007 if it found the storage the first one allocated + rather than a fresh zeroed copy of it. *) + let build_module src name = + let c = Session.eval t src in + let out = tmp name in + ignore (Build.shared ~opts:dev ~ir:c.Session.ir ~out ()); + out + in + let so1 = + build_module + "(defvar acc i64) (defn tick [] i64 (set acc (+ acc 1000)) acc)" + "tick1.so" + in + let so2 = + build_module "(defn tick [] i64 (set acc (+ acc 7)) acc)" "tick2.so" + in let sock = tmp "sock" in let out = tmp "out" in @@ -105,24 +120,38 @@ let () = (* "ok" means queued, not installed — the store happens on the other thread, at a time this one does not choose. *) - let reply = send sock so in + let lines () = + let text = In_channel.with_open_bin out In_channel.input_all in + List.length (String.split_on_char '\n' text) - 1 + in + let reply = send sock so1 in + if reply <> "ok\n" then fail "agent replied %S, wanted \"ok\\n\"" reply; + (* Wait for the program to have consumed the first module before sending + the second. Both at once is a legitimate thing for the agent to do — + one poll installs everything queued — but then only the last one is + ever observed and the sequencing is not what was tested. *) + if not (await (fun () -> lines () >= 2)) then + fail "the first reload was never installed"; + let reply = send sock so2 in if reply <> "ok\n" then fail "agent replied %S, wanted \"ok\\n\"" reply; let _, status = Unix.waitpid [] pid in let text = In_channel.with_open_bin out In_channel.input_all in - (* 1 from the original [tick], then 1001: the same call site, in a - program that never stopped, running a body that did not exist when it - started. *) - if status <> Unix.WEXITED 0 || text <> "1\n1001\n" then + (* 1 from the original [tick]; 1000 from a body that did not exist when + the program started, over a global that did not either; 1007 from a + second body that only reads it. That last number is the whole point of + doing this twice — a registry that handed out fresh storage per module + would say 7. *) + if status <> Unix.WEXITED 0 || text <> "1\n1000\n1007\n" then fail "agent reload\n got: %S (%s)\n wanted: %S" text (match status with | Unix.WEXITED c -> Printf.sprintf "exit %d" c | Unix.WSIGNALED c -> Printf.sprintf "signal %d" c | Unix.WSTOPPED c -> Printf.sprintf "stopped %d" c) - "1\n1001\n" + "1\n1000\n1007\n" end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) - [ exe; so; sock; out ]; + [ exe; so1; so2; sock; out ]; if !failures = 0 then print_endline "agent: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures;