diff --git a/lib/dev.ml b/lib/dev.ml index 5690dce..25d3ff7 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -527,6 +527,40 @@ let parked_msg why = let parked why = error (parked_msg why) +let contains hay needle = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + n = 0 || go 0 + +(* A module the agent would not take, said in the daemon's words rather than + only in the agent's. + + The agent refuses a full reload ring with "the program is not calling + agent/poll", which is the right cause for a program that is running and the + wrong one for a program that has finished. A parked process is not failing + to poll: it has no game thread left to poll with, it is waiting in the park + for somebody to run it again, and nothing drains the ring until then — so + the sixty-fifth module queued since it parked is refused for the very + behaviour [eval] below promises it — that a body redefined while parked + installs when the program is run again. A reader told to check their + [agent/poll] calls would go looking at a loop that is not running. + + The agent cannot say this itself. Parking is the merged shim's state and the + agent is vendored beside it knowing nothing about runs; what knows is this + daemon, which has just asked [liveness] and is about to quote a reply. So + the substitution is made here, on a substring of a reply this side did not + write — the same move [abi_mismatch] makes on [dlerror]'s text, and made for + the same reason: the component that has the words does not have the + context. *) +let refusal ~parked reply = + if parked && contains reply "reload queue full" then + "the program refused the module: its reload ring is full, and a parked \ + program drains none of it — every module queued since it finished is \ + still waiting for a frame boundary, and M-x flan-rerun is what gives it \ + one; this one was not queued, so send it again once the program is \ + running" + else "the program refused the module: " ^ reply + (* [pause], when given, is the position of the form to stop at — §9. It rides beside the code rather than in it, and the reply echoes it back so an editor marks the buffer only for a mark the session actually applied. @@ -607,7 +641,7 @@ let eval t ~code ~origin ~pause = when it is run again rather than at its next frame \ boundary" ] else [])) - | reply -> refused ("the program refused the module: " ^ reply) + | reply -> refused (refusal ~parked:parked_now reply) | exception Unix.Unix_error (e, _, _) -> refused ("cannot reach the program on " ^ t.agent ^ ": " @@ -714,7 +748,11 @@ let eval_expr t ~code ~origin ~pause = the wait then says: a timeout is a frame boundary not reached yet, not a module refused, so the instances in it stay in the session. Only the two arms below, where nothing was accepted, - put the session back. *) + put the session back. + + No [refusal] either, and that is not an omission: this verb + refuses a parked program before it compiles anything, so the one + reply whose cause that rewrites cannot arrive here. *) | reply -> refused ("the program refused the module: " ^ reply) | exception Unix.Unix_error (e, _, _) -> refused ("cannot reach the program: " ^ Unix.error_message e)) @@ -2064,11 +2102,6 @@ let run_capture cmd = let code = match Unix.close_process_in ic with Unix.WEXITED c -> c | _ -> -1 in (code, Buffer.contents b) -let contains hay needle = - let n = String.length needle and h = String.length hay in - let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in - n = 0 || go 0 - (* The IR of one function out of a module's text. [Emit] writes a define's closing brace at column 0 and nowhere else, so the end is unambiguous without parsing LLVM. One .ll can carry several bodies — [C-c C-k] sends a diff --git a/test/test_dev.ml b/test/test_dev.ml index 32c67df..05190c6 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -152,6 +152,42 @@ let contains_sub hay needle = in go 0 +(* ── Whose fault a full reload ring is ──────────────────────────────── *) + +(* The agent refuses a module it has no room to queue with "the program is not + calling agent/poll", and for a running program that is the cause. For a + parked one it is the wrong cause said confidently: there is no game thread + left to poll with, the ring is full precisely *because* the program + finished, and [Dev.eval]'s own note promises exactly that a body redefined + while parked installs when the program is run again. Somebody sent + the sixty-fifth one, and the reply sent them to read a loop that is not + running. + + Pinned on the decision rather than end to end. Filling the ring means + sixty-four modules through a real clang, which is minutes of [dune test] to + assert one sentence; what the daemon *does* with the agent's words is the + whole of the change, and it is a function of two arguments. The pass-through + is asserted too: a running program's refusal must still arrive in the + agent's own words, because for it they are true. *) +let () = + let full = "err reload queue full; the program is not calling agent/poll" in + let parked = Dev.refusal ~parked:true full in + if contains_sub parked "not calling agent/poll" then + fail "a parked program's queue-full refusal still blames its poll: %S" + parked; + if not (contains_sub parked "flan-rerun") then + fail "a parked program's queue-full refusal names no way out: %S" parked; + let live = Dev.refusal ~parked:false full in + if not (contains_sub live "not calling agent/poll") then + fail "a running program's queue-full refusal lost the agent's reason: %S" + live; + (* Only that one reply is rewritten. Every other refusal a parked program + can give — a bad ABI, a module with no installer — is the agent's to + explain and is quoted as it stands. *) + let other = Dev.refusal ~parked:true "err flan.abi.x86: the module is x86" in + if not (contains_sub other "flan.abi.x86") then + fail "a parked program's other refusals were rewritten too: %S" other + let () = match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with | 0 ->