diff --git a/FIX.org b/FIX.org index 3ac5af4..3167823 100644 --- a/FIX.org +++ b/FIX.org @@ -4252,3 +4252,94 @@ Noted, not fixed: and semantics never fork, so dyn slice should exist. - (slice "abc" 0 99) is not refused at compile time, because Types.String carries no length. Consistent with a slice of a slice; a missed nicety. + +* 2026-09-20 — an evaluated expression that signals says so at once +An expression evaluated from a buffer signalled a [BoundsError], the thunk +stopped in the break loop, and five seconds later the daemon answered "the +program did not reach a frame boundary; is it calling (agent/poll)?" — on a +reply that said [:stopped t :condition "BoundsError"] two fields along. The +program had reached the boundary, run the thunk, and stopped inside it. + +[eval_expr]'s wait recognised exactly one kind of stop: a [Pause], and only +when [:pause t] had asked for one. Every other stop fell through to the +timeout arm, which then chose between two sentences neither of which was about +a thunk sitting in the break loop. + +** The decision +The wait reads what it found on the way in, before the module is delivered, +and treats a stop entered after that as the thunk's. A fourth answer carries +the condition's name off [status] and is given at once, because a thunk in the +break loop will never produce a value on its own and waiting for one is +waiting for nothing: + + the expression stopped on BoundsError before it produced a value. The break + loop is holding it: take a restart, or abort + +5.15s to 0.01s on the reported case. + +"After that" is a *number*, not a name. [stop_gen] (lib/dev.ml) asks the +agent's [stop] verb, which answers [snap_top()->gen]; [snap_push] mints one on +every break entry including a nested one, never reuses it, and runs on both +backends. So the case a name cannot settle — evaluating from inside a break +into a thunk that stops on the same condition class — is settled by comparing +two integers. No new C: the verb is there, and the writable inspector two +screens down in the same file already uses it for the same kind of question. +The name stays as the fallback for an agent that cannot answer [stop], and the +old ambiguity comes back only there. + +Both timeout sentences stay as they were, and are now only said when they are +true — the frame-boundary one when the program is running, not parked, and +silent for five seconds. + +The [(pause)] path is not untouched, and saying so would be wrong. The split +is on the condition's name now, not on the [:pause t] flag. A plain [C-x C-e] +over an expression that calls a body somebody marked with [C-u C-c C-c] +reaches a [(pause)] this request never asked for, and used to spend five +seconds and then blame [(agent/poll)]. It answers [ok] with "stopped at +(pause)" at once, the same as the flagged case. Pinned in test_dev.ml on the +[dev-pause] daemon, over a function the program itself never calls. + +Which is why [(pause)] is not folded into the signalled arm. A breakpoint +firing is the feature working, and "the break loop is holding it: take a +restart, or abort" would be telling somebody to abort out of the breakpoint +they set on purpose. The flag was never what made a [(pause)] deliberate — +putting one there was. + +[:pause t] itself is unchanged in every case that exists. [Session.eval_expr] +splices the call *ahead* of the expression ([Do [pause_call; parsed]]), so a +flagged thunk always stops at its [(pause)] before the expression can run, and +"it signalled before reaching the pause" describes nothing reachable. An +earlier draft of this entry claimed otherwise. + +Cost, measured rather than assumed: the wait now asks [status] every tick +where it used to short-circuit on [pause &&] and ask nothing. 22µs a round +trip under [--two-process], 22ms over the thousand ticks of a full timeout, +against a five-second budget — and [ms - 5] counts ticks, so that is budget +inflation rather than time spent inside it. Four parts in a thousand. Left +alone. + +[run_render_thunk] shares the sentence and is stopped-only by design, with its +own [resumed] discriminator. Untouched. Emacs needed nothing: [flan--absorb] +already reads [:stopped]/[:condition] off every reply including errors, and +already schedules the break buffer. + +** Open: whose break it is, which no counter answers +The generation says a break is new. It does not say whose. + +[build_module] takes a couple of hundred milliseconds between the snapshot and +the delivery, and the wait runs for five seconds after it. A game loop that +signals on its own during either window bumps the generation exactly as a +thunk would, and the reply then says "the expression stopped on X" about an +expression that had not run. The machine-readable fields stay right — the +editor opens the break the program is really in — so what is wrong is the +sentence and only the sentence. + +Nothing counted can close it, because the program's break and the thunk's are +the same kind of event. What separates them is the per-frame "program"/"eval" +origin the backtrace already carries, and that is LLVM-only: the default x86 +backend pushes no shadow stack, so on the backend [flan dev] actually gives +you, it answers nothing. Closing it properly means x86 pushing frames in dev +builds, which is a lane of its own. + +Not queued. The window is narrow, the fields are right, and the wrong sentence +is a great deal better than the one it replaced. diff --git a/lib/dev.ml b/lib/dev.ml index 917c36b..480de94 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -990,6 +990,32 @@ let eval_expr t ~code ~origin ~pause = match Session.eval_expr ~origin ~pause t.session code with | c -> let before = match result t with Some (g, _) -> g | None -> 0L in + (* Read here, beside [before], and for the same kind of reason: all + three are the "how things stood" half of a difference the wait below + measures. A program already sitting in a break when the request + arrived is not a program the thunk stopped, and after delivery there + is no way left to tell the two apart. + + The generation is the one that actually decides it. [stop_gen] is + minted by [snap_push] on every break entry including a nested one and + never reused, so "greater than the one I came in on" *is* "a stop that + was not there before" — which two readings of [state] cannot say, for + the reason [stop_gen]'s note gives at its definition. The name is kept + beside it as the fallback for an agent that cannot answer the verb. + + As early as it usefully can be, and still not early enough to be + exact: [build_module] below takes a couple of hundred milliseconds, + and a game loop that signals *on its own* during them — or mid-wait, + while the thunk is still perfectly fine — bumps the generation too. + The reply then says "the expression stopped on X" about an expression + that had not run. Its machine-readable half stays right, so the editor + opens the break the program is actually in; only the sentence is + wrong, and no counter closes this one, because the program's break and + the thunk's are the same kind of event. Separating them wants the + per-frame origin the backtrace carries, which is LLVM-only. FIX.org + has it. *) + let entered = state t in + let entered_gen = stop_gen t in t.n <- t.n + 1; let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in (match build_module c ~debug:t.session.Session.debug ~out with @@ -1004,32 +1030,68 @@ let eval_expr t ~code ~origin ~pause = and a process whose program is elsewhere has no ring of ours to drain, so both refusals mean somebody else has it in hand. *) Program.wake (); - (* Three-way, and the middle case exists only because of [:pause]. - A thunk that stopped in the break loop produces no value and + (* Four-way, and two of the four are the same observation read + twice. A thunk sitting in the break loop produces no value and never will until someone resumes it — which is exactly what a program that never reached a frame boundary looks like from - here. Reporting the timeout for it would call the working - feature a failure. + here, so both of them have to be recognised or the timeout + answers for them and names the wrong cause. - The [Stopped] question is asked only when a pause was requested. - Without one, a thunk that stops did so by erroring, and the - timeout message is the answer that path has always given — - which [test_dev.ml] pins. + [Pause] is the arranged one and the split is on that word, not + on [:pause t]. A [(pause)] is somewhere because somebody put it + somewhere — [:pause t] wraps the whole expression in one, and a + mark set with [C-u C-c C-c] leaves one inside a body the + expression then calls. Both are the feature working, and a + breakpoint firing is not a failure, so both answer [ok] with the + note. Asking [:pause t] here instead would refuse the second + case a reply it had every right to, and the wait has no way to + know which [(pause)] it reached anyway. - And it asks for [Pause] by name, not for "stopped at all". The - break loop allows evaluating, so this is reachable from a - program already parked on something else — and [Stopped _] would - then answer for a thunk that has not run yet, on a reply whose - own [:condition] says the other condition's name. Asked by name - it waits through the outer break until the thunk reaches its own - [(pause)], which the agent reports because a nested break - overwrites [condition_name] and restores it on the way out. + Anything else is the thunk having *signalled* — a bad index, an + [error] with nobody handling it — and that used to wait out the + whole five seconds and then say the program was not polling. It + was polling. It polled, it ran the thunk, and the thunk stopped; + the very reply carrying that sentence said [:stopped t + :condition "BoundsError"] two fields along. The comment that + used to stand here claimed [test_dev.ml] pinned the timeout for + this case. Nothing did. - A program already parked on a [Pause] is the one case this - cannot tell apart, and nothing could: both answers are "stopped - at a pause". *) - let stopped () = - pause && (match state t with Stopped "Pause" -> true | _ -> false) + Neither is "stopped at all", and [entered_gen] is why. The break + loop allows evaluating, so both are reachable from a program + already sitting in a break — which "stopped at all" would answer + for on behalf of a thunk that has not run yet, on a reply whose + own [:condition] names the other condition. What is asked + instead is whether the stop in force is a *new* one, and the + generation answers that exactly: [snap_push] mints one on every + break entry, nested breaks included, and never reuses it. + + An earlier draft asked by name — stopped on something other than + what was found on the way in — and could not separate the one + pair that matters most: evaluating from inside a break into a + thunk that stops on the same condition class. Two [stopped Boom] + readings are identical and the generation is not. The name + survives as the fallback for an agent that cannot answer [stop], + where the old ambiguity comes back with it. + + Two asks on the tick that finds a stop and one on every other, + because the generation is only wanted once [state] says there is + a stop to ask about. They are two moments, so a resume and a + re-stop between them could pair a stale name with a fresh + generation; it cannot manufacture one, since the generation only + climbs when a break really was entered. *) + let settled now = + match now with + | Stopped c -> + let fresh = + match stop_gen t, entered_gen with + | Some g, Some g0 -> g > g0 + | _ -> + (match entered with Stopped c0 -> c0 <> c | _ -> true) + in + if not fresh then None + else if c = "Pause" then Some `Stopped + else Some (`Broke c) + | _ -> None in let rec wait ms = (* The pipe is drained on every tick, and that is what makes this @@ -1061,23 +1123,57 @@ let eval_expr t ~code ~origin ~pause = 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 - | _ when ms <= 0 -> `Timeout - | _ -> - ignore (Unix.select [] [] [] 0.005); - (* Not [Gone], where it used to be exactly [Live]. The old test - was right while the park ran nothing: a program that parked - mid-wait would never produce a value, so spinning out the - rest of the five seconds said nothing more than stopping - now did. A park that drains the ring makes it false in both - directions — a thunk delivered to a parked program is - waiting on this very wait, and a run that finishes while a - thunk is in flight parks and then polls it. What is left as - a reason to stop early is the process being gone, which is - the one state no amount of waiting recovers from. *) - if liveness t <> Gone then wait (ms - 5) else `Timeout + let value () = + match result t with + | Some (g, v) when Int64.compare g before > 0 -> Some v + | _ -> None + in + match value () with + | Some v -> `Value v + | None -> + (* One [status] ask a tick, with both questions answered off the + one reading. Two calls would be two round trips and, worse, + two moments: a thunk that stopped between them would be + running for one question and stopped for the other. + + Every tick, where the old test short-circuited on [pause &&] + and asked nothing at all without a [:pause t]. That is a real + change and it was measured rather than waved at: 22µs a round + trip over the agent socket under [--two-process], 22ms across + the thousand ticks of a full timeout, against a budget of five + seconds. In the merged default it is a function call in this + process and cheaper still. Worth knowing because [ms - 5] + counts ticks and not the clock, so the round trip inflates the + budget rather than fitting inside it — by four parts in a + thousand, which is not worth a second timing source. + + And the value is asked for again before a stop is answered, + because the two reads above are themselves two moments and a + stop ends the wait: a value published between them would + otherwise be dropped on the floor with no next tick to find + it. The order matters, not the count — a thunk that produced a + value and *then* hit a second break has a value, and that is + what the reply should carry. *) + match settled (state t) with + | Some answer -> + (match value () with Some v -> `Value v | None -> answer) + | None -> + if ms <= 0 then `Timeout + else begin + ignore (Unix.select [] [] [] 0.005); + (* Not [Gone], where it used to be exactly [Live]. The old + test was right while the park ran nothing: a program that + parked mid-wait would never produce a value, so spinning + out the rest of the five seconds said nothing more than + stopping now did. A park that drains the ring makes it + false in both directions — a thunk delivered to a parked + program is waiting on this very wait, and a run that + finishes while a thunk is in flight parks and then polls + it. What is left as a reason to stop early is the process + being gone, which is the one state no amount of waiting + recovers from. *) + if liveness t <> Gone then wait (ms - 5) else `Timeout + end in (match wait 5000 with | `Value v -> ok [ ":value " ^ Wire.quote v ] @@ -1085,8 +1181,28 @@ let eval_expr t ~code ~origin ~pause = one until the break is resumed. [:stopped t :condition "Pause"] rides on this reply as it does on every other — [with_break] puts it there — so the editor already has what it needs, and - the note says which of the two silences this is. *) + the note says which of the two silences this is. + + [ok] and not an error, for a [(pause)] the expression wrapped + and for a [(pause)] a mark left in a body it called alike. The + words fit both: what a reader wants to know is that the + expression is at a breakpoint rather than lost, and *which* + breakpoint is the break buffer's business, not this line's. *) | `Stopped -> ok [ ":note " ^ Wire.quote "stopped at (pause)" ] + (* The name is the agent's, read off [status] a moment ago, and + not a guess: a sentence that named the wrong condition would + be the same defect as the one below, one field smaller. No + [:value], because the thunk stopped before it made one and + will not make one until the break is answered — which is why + this does not wait: there is nothing left to wait for. + [:stopped t :condition] rides on this reply as it does on + every other, so the editor has already opened the break + buffer by the time the sentence is read. *) + | `Broke c -> + error + ("the expression stopped on " ^ c + ^ " before it produced a value. The break loop is holding \ + it: take a restart, or abort") (* Two sentences, because there are two causes and the running one is nonsense about a parked program — it is the sentence this verb's old refusal quoted, which is exactly the thing not @@ -1094,7 +1210,18 @@ let eval_expr t ~code ~origin ~pause = nothing else can be holding it up, so what has gone wrong is the thunk itself: it stopped on something and is sitting in the break loop waiting to be told what to do. That is a state the - editor can act on, and [:stopped] on this reply names it. *) + editor can act on, and [:stopped] on this reply names it. + + Both of them are narrower than they read, because [`Broke] + above now takes every stop the generation can see, which is + every stop entered after the request arrived. What is left for + the parked sentence is an agent that could not answer [stop] at + all, falling back to the name and losing the same-condition + case with it — which is why it still says "most likely" rather + than naming anything. The frame-boundary sentence keeps what is + left over, which is the shape it was always about: a program + that is running, is not parked, and produced nothing in five + seconds. *) | `Timeout -> if liveness t = Parked then error diff --git a/lib/session.ml b/lib/session.ml index 7b89074..63b618d 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1934,8 +1934,8 @@ let eval_expr ?(origin = "") ?(pause = false) t src : change = would work and a package's would be an unknown name. Expansion happens here, before the thunk is built and long before the - agent is asked for anything, so the three-way wait in [Dev.eval_expr] is - untouched: a cold macro module costs its ~300ms before that clock starts, + agent is asked for anything, so the wait in [Dev.eval_expr] is untouched: + a cold macro module costs its ~300ms before that clock starts, and the non-termination refusals raise [Loc.Error] out of this call, which the daemon already answers as an error rather than a silence. *) let parsed = Parse.with_imported ~decls:(package_decls t) t.macros (fun () -> Parse.expr form) in diff --git a/test/test_dev.ml b/test/test_dev.ml index fb53d20..b91d6f4 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -3309,6 +3309,114 @@ let () = end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ csock; cout ]; + (* ── An expression that signals, and the sentence it gets ───────── *) + + (* The other way the wait used to name the wrong cause, and the one that + was reported from a real session: an expression evaluated from a buffer + signalled a [BoundsError], the thunk stopped in the break loop, and five + seconds later the daemon said "the program did not reach a frame + boundary; is it calling (agent/poll)?" — on a reply that said + [:stopped t :condition "BoundsError"] two fields along. The program had + reached the boundary, run the thunk, and stopped in it. + + The chatty block above is the same failure from the other end: there the + sentence was wrong because the program could not get to a boundary, here + because it got there and the thunk never came back. Both now answer what + is true of them. + + Three claims. The condition is named, and named from what the agent + reported rather than from anything guessed here — a [BoundsError] and + not an [error] the fixture raises, because the fixture raises none and + the expression is the whole of what stops. The frame-boundary sentence + is *not* said. And it is said at once: a thunk in the break loop + produces no value until someone answers the break, so waiting for one is + waiting for nothing, and the wait disappearing is the point of the + change rather than a side effect of it. + + [--llvm], and the x86 half of the same claim is on the [dev-pause] + daemon further down, where an expression that errs inside a thunk is + already evaluated against the default backend. The diagnostic is + backend-independent — it is read off [status] and nothing else — so a + daemon each is what covers it without a third compile. *) + let sigsock = tmp "signal.sock" and sigout = tmp "signal.out" in + (try Sys.remove sigsock with Sys_error _ -> ()); + let sigfd = + Unix.openfile sigout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let sigpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-repl.flan"; "-s"; sigsock; "--llvm" |] + Unix.stdin sigfd Unix.stderr + in + Unix.close sigfd; + if not (listening ~pid:sigpid sigsock) then begin + fail "the signalling-expression daemon %s" !listen_why; + (try Unix.kill sigpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect sigsock in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + (* A value first, so that "it answered fast" below is about this + expression and not about a daemon that was refusing everything. *) + let r = + request c "(:op \"eval-expr\" :code \"(+ 1 1)\" :file \"/tmp/signal.flan\")" + in + if Wire.string_field r "value" <> Some "2" then + fail "the signalling-expression daemon did not evaluate a plain one: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")); + (* [(+ ticks 100)] rather than a literal 9: [ticks] is the fixture's own + counter and is never negative, so the index is out of a length-4 array + whatever the program has got to, and it is out of range at run time + rather than at check time. *) + let started = Unix.gettimeofday () in + let r = + request c + "(:op \"eval-expr\" :code \"(at [1 2 3 4] (i32 (+ ticks 100)))\" \ + :file \"/tmp/signal.flan\")" + in + let took = Unix.gettimeofday () -. started in + let said = Option.value ~default:"" (Wire.string_field r "message") in + if status r <> "error" then + fail "an expression that signalled was reported as %s" (status r); + if not (contains_sub said "stopped on BoundsError") then + fail "an expression that signalled was reported as: %s" said; + if contains_sub said "agent/poll" then + fail + "a thunk stopped in the break loop was diagnosed as a program that \ + is not polling, which is the defect and not the symptom"; + (* Under the daemon's own five-second wait, and measured the way the + chatty block measures: the clock starts before the module is built, so + a compile on a loaded machine is inside this number and the bound is + not a measurement of anything. What it rules out is the one thing that + matters — the wait being spent before the answer. *) + if took > 4.5 then + fail "an expression that signalled took %.1fs to say so" took; + (* And the machine-readable half, which the editor reads rather than the + sentence: the break buffer opens off these two fields. *) + if not (stopped r) then + fail "an expression that signalled did not carry :stopped"; + if Wire.string_field r "condition" <> Some "BoundsError" then + fail "an expression that signalled carried :condition %s" + (Option.value ~default:"" (Wire.string_field r "condition")); + ignore (request c "(:op \"close\")"); + (try Unix.close c with Unix.Unix_error _ -> ()); + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] sigpid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill sigpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] sigpid) with Unix.Unix_error _ -> ()) + end + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sigsock; sigout ]; + (* --debug, and the half the IR cannot show. [test_session.ml] asserts that a debug session *emits* the metadata, @@ -3710,6 +3818,87 @@ let () = end end end; + + (* The other way a thunk reaches a [(pause)], and the one no flag asks + for: an ordinary [C-x C-e] over an expression that calls a body + somebody marked earlier. The mark is the one above, set on a + declaration rather than on the expression, and the expression knows + nothing about it. + + Its own function, and one the program never calls. Marking [step] + would stop the *program* within 5ms — before the module is even built + — and the reply would then be right about a break that was nothing to + do with the thunk. The claim is about a stop the expression caused, so + the fixture has to leave only one way to reach it. + + [ok] with the note, not the error the signalling case gets. A + breakpoint firing is the feature working; "the break loop is holding + it: take a restart, or abort" would be telling somebody to abort out + of the breakpoint they set on purpose. *) + let idle = "(defn idle [] i64 (+ 1 1))" in + let icol = + let n = String.length "(+ 1 1)" in + let rec find i = + if i + n > String.length idle then 0 + else if String.equal (String.sub idle i n) "(+ 1 1)" then i + 1 + else find (i + 1) + in + find 0 + in + if icol = 0 then fail "the marked-body test cannot find its own target"; + let r = + ask + (Printf.sprintf + "(:op \"eval\" :code %s :file \"/tmp/buf.flan\" :pause (1 %d))" + (Wire.quote idle) icol) + in + if status r <> "ok" then + fail "installing a marked body the program never calls: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else begin + (* Nothing has stopped: the program does not call [idle], so the mark + sits there until the expression below reaches it. Without this the + assertions after it would pass off the program's own break. *) + ignore (Unix.select [] [] [] 0.05); + if stopped (ask "(:op \"describe\")") then + fail "marking a body the program never calls stopped it anyway"; + let started = Unix.gettimeofday () in + let r = + ask "(:op \"eval-expr\" :code \"(idle)\" :file \"/tmp/buf.flan\")" + in + let took = Unix.gettimeofday () -. started in + if status r <> "ok" then + fail + "a plain expression that reached a marked (pause) was reported as \ + a failure: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if Wire.string_field r "value" <> None then + fail "an expression stopped at a marked (pause) answered with a value"; + (match Wire.string_field r "note" with + | Some n when contains_sub n "(pause)" -> () + | n -> + fail "an expression stopped at a marked (pause) noted: %s" + (Option.value ~default:"" n)); + if not (stopped r) then + fail "an expression stopped at a marked (pause) did not carry :stopped"; + if Wire.string_field r "condition" <> Some "Pause" then + fail "an expression stopped at a marked (pause) carried :condition %s" + (Option.value ~default:"" (Wire.string_field r "condition")); + (* And at once. Before the stop generation this fell past every test + the wait had and spent the whole five seconds, to end on the + frame-boundary sentence about a program that was polling fine. *) + if took > 4.5 then + fail "an expression that reached a marked (pause) took %.1fs" took; + (* Unwound before anything else runs, or every check below this would + be reading the thunk's break instead of its own. *) + let r = ask "(:op \"restart\" :name \"continue\")" in + if status r <> "ok" then + fail "continue at a marked body's breakpoint: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the program never resumed from a marked body's breakpoint" + end; + (* C-u C-x C-e: the same feature for §9's "last expression" target, and a flag rather than a position because the expression sent is the whole of it. The reply it must *not* give is the timeout, which is @@ -3752,11 +3941,28 @@ let () = request arrives, so anything less specific would answer for a thunk that has not run yet — and answer it on a reply whose own [:condition] names the other condition. *) + let started = Unix.gettimeofday () in let r = ask "(:op \"eval-expr\" :code \"(i64 (boom))\" :file \"/tmp/buf.flan\")" in + let took = Unix.gettimeofday () -. started in if status r <> "error" then fail "an expression that erred inside a thunk answered anyway"; + (* And it says so rather than waiting the wait out. A thunk in the break + loop will not produce a value until someone answers the break, so the + five seconds buy nothing — they used to be spent and then reported as + a program that was not polling. 4.5 for the chatty block's reason and + not because that is how long this takes: the clock starts before the + module is built, so a loaded machine's compile is inside this number, + and the only claim being made is that the daemon's own five-second + wait was not spent. *) + if took > 4.5 then + fail "an expression that erred inside a thunk took %.1fs to say so" took; + (match Wire.string_field r "message" with + | Some m when contains_sub m "stopped on Missing" -> () + | m -> + fail "an expression that erred inside a thunk was reported as: %s" + (Option.value ~default:"" m)); if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then fail "the program never stopped on the expression that errs" else begin @@ -3788,7 +3994,50 @@ let () = fail "resuming the outer break: %s" (Option.value ~default:"" (Wire.string_field r "message")); if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then - fail "the program never resumed from the outer break" + fail "the program never resumed from the outer break"; + + (* And the pair that the condition's *name* cannot separate, which is + what the stop generation is here for. Stop the program on [Missing], + then evaluate an expression that stops on [Missing] as well: two + readings of [status] are the same four words, and "is this still the + break I came in on" has no answer in them. [snap_push] mints a + generation on every break entry including a nested one, so the + second stop is a *number* larger than the first and the thunk's + break is told apart from the one it was evaluated inside. + + Both halves are asserted, because either alone would pass for the + wrong reason: the sentence, which a name-only test would get wrong + by saying nothing had stopped, and the clock, which is the whole + difference between recognising the stop and waiting the five seconds + out and then guessing at it. *) + let r = + ask "(:op \"eval-expr\" :code \"(i64 (boom))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "an expression that stops the program was reported as %s" + (status r); + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the program never stopped ahead of the same-condition case" + else begin + let started = Unix.gettimeofday () in + let r = + ask + "(:op \"eval-expr\" :code \"(i64 (boom))\" :file \"/tmp/buf.flan\")" + in + let took = Unix.gettimeofday () -. started in + (match Wire.string_field r "message" with + | Some m when contains_sub m "stopped on Missing" -> () + | m -> + fail + "a thunk that stopped on the condition its break was already \ + on was reported as: %s" + (Option.value ~default:(status r) m)); + if took > 4.5 then + fail + "the same-condition case took %.1fs, so it was found by waiting \ + rather than by the stop generation" + took + end end; ignore (ask "(:op \"close\")"); Unix.close c