JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A program that prints is not a program that stopped polling

Browse Source 
The merged build's stdout is a 64K pipe back into the daemon's own process,
and the accept loop is the only thing reading it -- which it is not doing
while serve is answering a request. The two five-second waits for a frame
boundary now drain the pipe on every tick, so a program stopped inside fwrite
is one the daemon lets go rather than one it waits out and then accuses of
not calling agent/poll.

drain and not take: the text stays in the buffer until with_output puts it on
the reply, which is where the output an evaluation caused belongs. And the
drain sits beside the sleep rather than inside the select, because a readable
pipe would make the tick free and count the timeout out in a fraction of it.

dev-chatty.flan prints 4K a frame, which is the only fixture here that fills
the pipe at all; without the drain it fails in 5.1s with the old sentence.
This commit is contained in:
Joseph Ferano 2026-09-18 07:31:25 +07:00
parent ce3e879e83
commit 6197b32b50
3 changed files with 178 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lib/dev.ml
View File

@ -57,7 +57,14 @@ type t = {
(* The program's stdout is a pipe into this process, so that an editor can see
it. That makes draining it a *liveness* requirement and not a nicety: a pipe
nobody reads fills at 64K and the next write blocks the program forever. So
it is read from the accept loop's select, not only when someone asks. *)
it is read from the accept loop's select, not only when someone asks.
The accept loop is not enough on its own, and that is the other half of the
same requirement: it is not running while [serve] is handling a request, and
two of the things [serve] does are five-second waits for the game thread to
reach a frame boundary. A thread blocked in [fwrite] reaches none. So
[drain] is called from those waits as well — see [eval_expr], which carries
the argument. *)
let capacity = 256 * 1024
let drain t =
@ -657,6 +664,35 @@ let eval_expr t ~code ~origin ~pause =
pause && (match state t with Stopped "Pause" -> true | _ -> false)
in
let rec wait ms =
(* The pipe is drained on every tick, and that is what makes this
a wait rather than a deadlock.
In the merged build fd 1 is a 64K pipe back into this process,
and its only other reader is the select in [accept_loop] —
which is not running, because it is further up this very call
stack, inside [serve]. A program that prints as it goes (and a
game loop prints as it goes; sand.flan does) fills those 64K
while the module below was being built, and the game thread is
then stopped inside [flan_write_stdout], in an [fwrite] that
will not return until somebody reads. It never reaches the
frame boundary the thunk needs. Five seconds later this
answered "is it calling (agent/poll)?" — a true sentence about
a program that is calling it and cannot get there, which is the
worst kind of diagnostic there is.
[drain] and not [take]: the text belongs in [t.out] until
[with_output] puts it on this reply on the way out of [serve].
Taking it here would empty the buffer into nothing and lose
exactly the output the evaluation itself caused.
And the drain goes *beside* the sleep rather than into it.
Putting [t.stdout] in the select's read set is the obvious
shape and is wrong: a readable pipe returns from select
immediately, so a tick stops costing 5ms and [ms - 5] counts
the whole five seconds out in a fraction of one — the same
wrong sentence, arrived at faster. The timeout is a clock, so
the sleep has to stay a sleep. *)
drain t;
match result t with
| Some (g, v) when Int64.compare g before > 0 -> `Value v
| _ when stopped () -> `Stopped
@ -1023,6 +1059,15 @@ let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result =
Error ("cannot reach the program: " ^ Unix.error_message e)
| "ok" ->
let rec wait ms =
(* Drained every tick for the reason [eval_expr]'s own wait spells
out: this loop is inside [serve], so the accept loop's select is
not reading the program's pipe, and a program that has filled it is
a program stopped in [fwrite] rather than one that is ignoring
[agent/poll]. A render thunk is asked for while the program is
*stopped* at a break, which is the state in which the last thing
printed matters most — so losing it to [take] would be worse here
than anywhere. *)
drain t;
match result t with
| Some (g, v) when Int64.compare g before > 0 -> Some v
| _ when ms <= 0 -> None

41
test/programs/dev-chatty.flan Normal file
View File

@ -0,0 +1,41 @@
;;;; A program that prints far more than a pipe holds, for the one failure a
;;;; quiet fixture cannot reach.
;;;;
;;;; In a merged `flan dev' the program's stdout is a 64K pipe back into the
;;;; same process, and the only thing reading it is the daemon's accept loop —
;;;; which is not running while the daemon is answering a request. Every other
;;;; fixture here prints a line or two per frame, so the pipe never fills and
;;;; the arrangement looks sound. This one prints 4K per frame, which fills 64K
;;;; in sixteen frames: less time than a module takes to build. By the time an
;;;; evaluation is delivered the game thread is stopped inside fwrite, and it
;;;; stays there until somebody reads — so a daemon that waits for a frame
;;;; boundary without draining waits for one that cannot arrive, and then says
;;;; the program is not calling (agent/poll).
;;;;
;;;; It is calling it. See lib/dev.ml's [eval_expr], which drains every tick.
(import agent "vendor:agent")
;;; Counted so that an evaluation has something of the program's own to read,
;;; and so a transcript can be checked for progress rather than only for text.
(defvar frames i64)
(defn chatter [] i64
;; Sixty-four lines of sixty-three characters and a newline: 4096 bytes a
;; frame, written through the line buffer flan_rt.c asks for, so each line
;; is its own write and the block happens in the middle of a frame rather
;; than at a flush somewhere else.
(dotimes [i 64]
(println "..............................................................."))
(set frames (+ frames 1))
frames)
(defn main [] i32
(agent/start "/tmp/flan-dev-chatty-fallback.sock")
;; 24000 for dev-repl.flan's reason: the test closes the connection when it
;; is done and the daemon takes the program with it, so the count only has
;; to outlast the checks. A program that reached its last frame mid-test
;; would fail honestly and for the wrong reason.
(dotimes [i 24000]
(chatter)
(agent/wait 1))
0)

91
test/test_dev.ml
View File

@ -2293,6 +2293,97 @@ let () =
end;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ];
(* ── A program that prints more than the pipe holds ─────────────── *)
(* The one thing every other fixture in this file is too quiet to reach.
In a merged build the program's stdout is a 64K pipe back into the
daemon's own process, and the only reader is the select in
[Dev.accept_loop] — which is not running while [serve] is answering a
request. [programs/dev-chatty.flan] prints 4K a frame, so those 64K are
full within sixteen frames, which is far less than a module takes to
build. The game thread is then stopped inside [fwrite] and reaches no
frame boundary at all; the thunk this evaluation delivers has nowhere to
run.
What that used to produce was five seconds of polling and then "the
program did not reach a frame boundary; is it calling (agent/poll)?" —
about a program whose every frame calls it. A diagnostic that names the
wrong cause is worse than none, because it is believed.
Three claims, and the third is not decoration. The value comes back, so
the thunk ran. The reply is not the frame-boundary sentence, so the
timeout is not being reached by some other route. And the program's text
rides on the reply as [:output] — which is the claim that the drain went
through [Dev.drain] and not [Dev.take]: a wait that took the buffer and
threw it away would satisfy the first two and silently delete the output
the evaluation itself caused, which is the output anyone wants to see. *)
let csock = tmp "chatty.sock" and cout = tmp "chatty.out" in
(try Sys.remove csock with Sys_error _ -> ());
let cfd = Unix.openfile cout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let cpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-chatty.flan"; "-s"; csock |]
Unix.stdin cfd Unix.stderr
in
Unix.close cfd;
if not (listening ~pid:cpid csock) then begin
fail "the chatty daemon %s" !listen_why;
(try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect csock in
(* Long enough for the program to have run the sixteen frames that fill
the pipe before anything is asked of the daemon. It prints at 4K a
frame with a 1ms wait between them, so this is an order of magnitude
more than it needs — the point is only that the pipe is full when the
request lands, not how full. *)
ignore (Unix.select [] [] [] 0.3);
let started = Unix.gettimeofday () in
let r =
request c "(:op \"eval-expr\" :code \"(+ 20 22)\" :file \"/tmp/chatty.flan\")"
in
let took = Unix.gettimeofday () -. started in
let said = Option.value ~default:"" (Wire.string_field r "message") in
if status r <> "ok" then
fail "evaluating against a program that is printing: %s" said
else if Wire.string_field r "value" <> Some "42" then
fail "the value from a printing program is %s"
(Option.value ~default:"none" (Wire.string_field r "value"));
if contains_sub said "agent/poll" then
fail
"a printing program was diagnosed as one that is not polling, which \
is the defect and not the symptom";
(* The wait is five seconds, so anything near it is the timeout being
reached rather than a slow machine. Two is the compromise: a cold
[llc] under dune's own parallelism is comfortably inside it, and a
run that blocked is comfortably outside. *)
if took > 2.0 then
fail "evaluating against a printing program took %.1fs" took;
(* And the program's own text came back on the reply rather than being
drained into nothing. *)
(match Wire.string_field r "output" with
| Some o when contains_sub o "......" -> ()
| Some _ -> fail "the reply carried output, but not the program's"
| None ->
fail
"the evaluation drained the program's pipe and kept none of it, so \
the output it caused is gone");
ignore (request c "(:op \"close\")");
(try Unix.close c with Unix.Unix_error _ -> ());
if not
(await ~ms:5000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] cpid with
| 0, _ -> false
| _ -> true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] cpid) with Unix.Unix_error _ -> ())
end
end;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ csock; cout ];
(* --debug, and the half the IR cannot show.
[test_session.ml] asserts that a debug session *emits* the metadata,