diff --git a/lib/dev.ml b/lib/dev.ml index b3d6709..fc613f6 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -52,6 +52,18 @@ type t = { The merged build keeps fd 1 open across runs now and is asked instead — see [liveness] and [Program.state]. *) mutable finished : bool; + (* When to start saying that the program has not bound [agent] — and [None] + once it has, or once that has been said. The merged session arms it and + nothing gates on it: see [agent_check] for why this is a clock a reply + passes rather than a wait the session does before it serves anything. *) + mutable agent_watch : float option; + (* Whether the long note about a delivery to a parked program has been said + for *this* park. A finished program is parked, so re-evaluating while one + is on the screen says it on every C-c C-c; the explanation is worth one + reading and not twenty. Cleared whenever the program is seen running + again ([eval]) and when a re-run is accepted ([rerun]), so the next park + is a new one and gets the whole sentence. *) + mutable park_noted : bool; } (* The program's stdout is a pipe into this process, so that an editor can see @@ -106,6 +118,48 @@ let await ?(ms = 5000) f = in go ms +(* Whether the program has bound the socket it receives modules on. + + Cheap enough to ask on every reply — one [stat] — and asked rather than + remembered because the answer moves in one direction at a moment this side + does not get to see: [agent/start] runs on the program's own thread. *) +let agent_bound t = Sys.file_exists t.agent + +(* And the clock that says so out loud, once. + + This used to be a [await ~ms:10000] in [merged_serve], *before* the accept + loop was started — so a program that called [agent/start] late, or not at + all, cost every editor request up to ten seconds of silence at the start of + a session. The wait was never what made the editor protocol work: nothing + the editor asks needs the program's socket, because in one process the + compiler reaches the agent by calling it ([Agent.request]), and the + two-process daemon has already waited for the bind in [two_process] and + fails if it never comes. What the wait was for is the *sentence* — a + program with no [(agent/start ...)] in it should say so rather than look + idle — and a sentence does not need to be in front of the loop to be said. + + So it is a deadline the session passes rather than a wait it does. Checked + from the accept loop between connections and from [serve] before each + request, which are the two places this thread can be: an editor holds one + connection for a whole session, so the loop is not cycling while it is + attached, and the request is then the only tick there is. The cost of that + is the warning landing on the first request after the deadline rather than + on the deadline itself; the alternative is a thread, and [lib/dune] has a + comment about what the merged link does to a library that grows one. *) +let agent_check t = + match t.agent_watch with + | None -> () + | Some deadline -> + if agent_bound t then t.agent_watch <- None + else if Unix.gettimeofday () >= deadline then begin + (* Said once. A program that is never going to start an agent would + otherwise repeat this on every keystroke's worth of polling. *) + t.agent_watch <- None; + Printf.eprintf + "flan dev: the program is not listening on %s — does it call \ + (agent/start ...)?\n%!" t.agent + end + (* ── Asking the agent ──────────────────────────────────────────────── *) (* One line out, one line back. The agent is not a protocol and must not become @@ -687,6 +741,59 @@ let refusal ~parked reply = one was not taken, so send it again after that run" else "the program refused the module: " ^ reply +(* What a taken module still has to say about itself. The delivery succeeded — + the agent dlopened it and published it to its ring — so this is never a + refusal; it is the difference between "queued" and "running", which is a + difference only the program can close and only at a moment of its choosing. + + Three of them, in the order of how far the module is from being live: + + A PARKED program has finished [main] and is asleep in [flan_merged_park]. + Its ring is drained by the park's own poll when it is woken and by the next + run's frame boundaries, so the module lands no later than that run — and an + expression evaluated in the meantime takes it first, because the poll that + runs a thunk installs whatever is queued ahead of it. That is the whole + sentence, and it is worth reading once. It is not worth reading on every + C-c C-c, and a finished program is parked, so every redefinition while a + run's output is still on the screen used to repeat it. [park_noted] is what + makes the second one a line instead of a paragraph; the rule is per park, + not per session, because the reader of a *new* park may not be the reader + of the last one. + + A RUNNING program that has not bound its agent socket has not called + [(agent/start ...)] yet — it may be about to, ahead of a window that is + still being created, or it may have no such call at all. Either way the + module is in the ring and the ring is drained by [(agent/poll)], so what + can honestly be promised is the poll and not a frame: a program with no + poll in it never installs this, and saying "at its next frame boundary" + would be the reply that made a redefinition look applied when it was not. + + A RUNNING program that has bound it needs no note: the reply already says + queued, and the frame boundary is the next one it reaches. *) +let install_note t ~parked = + if parked then begin + let first = not t.park_noted in + t.park_noted <- true; + [ ":note " + ^ Wire.quote + (if first then + "queued; the program is parked, so this installs no later than \ + its next run rather than at its next frame boundary — an \ + expression evaluated in the meantime takes it first, because \ + the poll that runs a thunk installs whatever is queued ahead \ + of it" + else "queued; installs no later than the parked program's next run") + ] + end + else if not (agent_bound t) then + [ ":note " + ^ Wire.quote + "queued, but the program has not called (agent/start ...) yet, so \ + this installs when it next reaches an (agent/poll) — and not at \ + all if it never does" + ] + else [] + (* [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. @@ -706,6 +813,12 @@ let refusal ~parked reply = let eval t ~code ~origin ~pause = let now = liveness t in let parked_now = now = Parked in + (* A park that is over takes its note with it: the long sentence below is + said once per park, and this is where a new one starts being possible. + Written on every eval rather than on the transition, because there is no + transition to hook — the program parks itself on its own thread and this + side finds out by asking. *) + if not parked_now then t.park_noted <- false; (* What the session was before the form was checked, and every failure below puts it back. [Session.eval] commits as soon as the check succeeds, which is two fallible steps too early: the build can fail and the agent can @@ -779,15 +892,7 @@ let eval t ~code ~origin ~pause = | Some (l, c) -> [ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ] | None -> []) - @ (if parked_now then - [ ":note " - ^ Wire.quote - "queued; the program is parked, so this installs no \ - later than its next run rather than at its next \ - frame boundary — an expression evaluated in the \ - meantime takes it first, because the poll that runs \ - a thunk installs whatever is queued ahead of it" ] - else [])) + @ install_note t ~parked:parked_now) | reply -> refused (refusal ~parked:parked_now reply) | exception Unix.Unix_error (e, _, _) -> refused @@ -968,6 +1073,21 @@ let eval_expr t ~code ~origin ~pause = program is parked, so nothing is competing with it: the \ thunk is most likely stopped on a condition inside the \ break loop, which restart or abort answers" + (* And a third cause, which is the one a session now reaches + early enough to hit: the program has not bound its agent + socket, so it is still ahead of its own [(agent/start ...)] + — inside whatever it does first, a window being created — + and asking whether it calls [(agent/poll)] would send the + reader to look at a loop it has not got to yet. Said only + where it is a fact about *this* program: the socket is + missing, which is a stat, not a guess. *) + else if not (agent_bound t) then + error + "the program has not called (agent/start ...) yet, so \ + nothing has run the expression. It is queued and will run \ + at the program's first (agent/poll); this reply cannot \ + carry its value, so evaluate it again once the program is \ + up" else error "the program did not reach a frame boundary; is it calling \ @@ -2574,6 +2694,12 @@ let rerun t = | Live | Parked -> (match Program.rerun () with | Ok () -> + (* The park this session was explaining is over, so the park after it + gets the explanation again — see [install_note]. Cleared here as + well as in [eval] because a run can start and finish with nothing + evaluated in between, and the next park would otherwise inherit a + flag set by the last one. *) + t.park_noted <- false; (* Taken is not always started, and the one case where it is not needs saying rather than a mechanism. A thunk evaluated against the park can stop in the break loop, and the parked thread is then inside that @@ -3357,6 +3483,10 @@ let serve t fd = let rec go () = match Wire.recv fd with | src -> + (* One of the two places the agent clock is read — see [agent_check]. + An attached editor keeps this loop, and not the accept loop, running + for the whole of a session. *) + agent_check t; (* Parsed once, and the verb taken out of it before anything that can fail: [close] has to be honoured even when the handler for it did not return normally, and a tuple whose two halves are [Wire.string_field] @@ -3508,6 +3638,9 @@ let accept_loop ?grace t ls = is held for an hour is an hour of the clock not running. *) let served = ref false and since = ref (Unix.gettimeofday ()) in let rec go () = + (* The other place the agent clock is read: between connections, which is + where a session with no editor attached spends its time. *) + agent_check t; match liveness t with | Gone -> () | (Live | Parked) as live -> @@ -3634,7 +3767,8 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () = let t = { session; child = Some child; agent; dir; stdout = rd; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; - host_ll; host_exe = exe; finished = false } + host_ll; host_exe = exe; finished = false; agent_watch = None; + park_noted = false } in ignore_sigpipe (); (try Unix.unlink sock with Unix.Unix_error _ -> ()); @@ -4384,7 +4518,8 @@ let merged_setup () = let t = { session; child = None; agent; dir; stdout = rd; out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32; - host_ll; host_exe = exe; finished = false } + host_ll; host_exe = exe; finished = false; agent_watch = None; + park_noted = false } in ignore_sigpipe (); (try Unix.unlink sock with Unix.Unix_error _ -> ()); @@ -4422,15 +4557,24 @@ let merged_serve () = | None -> prerr_endline "flan dev: serve was called before setup"; exit 1 | Some (t, ls, sock) -> (* The agent is bound by the program on the main thread, which only starts - once [merged_setup] has returned — so unlike the daemon, this waits - *after* it is already serving. An editor connecting in the meantime is - answered; only a delivery needs the agent. A program that never calls - [agent/start] is a warning rather than a failure now, because the thing - the daemon would have killed for it is this process. *) - if not (await ~ms:10000 (fun () -> Sys.file_exists t.agent)) then - Printf.eprintf - "flan dev: the program is not listening on %s — does it call \ - (agent/start ...)?\n%!" t.agent; + once [merged_setup] has returned. So this does not wait for it: it arms + the clock that eventually says it never came, and serves. + + That was the bug. The wait used to be here, in front of [accept_loop], + so the listening socket was up — an editor connected fine — and nothing + answered until the program bound its own socket or ten seconds ran out. + A program that calls [(agent/start ...)] after something slow (a window + being created) or never at all made that the cost of the *first* thing + anybody asked the session, every session. Nothing the editor asks needs + the program's socket — in one process a delivery is a call, not a + connect — so the wait was gating the whole protocol on a fact only the + agent's own verbs care about. + + A program that never calls [agent/start] is still a warning rather than + a failure, because the thing the daemon would have killed for it is + this process. See [agent_check] for where the sentence is said now, and + [eval] for what a delivery to such a program honestly reports. *) + t.agent_watch <- Some (Unix.gettimeofday () +. 10.); (match accept_loop t ls with | () -> () | exception e -> diff --git a/test/programs/dev-lateagent.flan b/test/programs/dev-lateagent.flan new file mode 100644 index 0000000..dd9eea4 --- /dev/null +++ b/test/programs/dev-lateagent.flan @@ -0,0 +1,36 @@ +;;;; A program that does call (agent/start ...) — but only after something +;;;; slow, which is the shape a real one has. +;;;; +;;;; sand.flan opens a window first and starts the agent afterwards, so on a +;;;; machine where window setup takes a while the socket appears seconds into +;;;; the run. [merged_serve] used to wait up to ten seconds for that socket +;;;; *before* starting its accept loop, so those seconds were charged to the +;;;; first thing the editor asked, every session. This fixture is that delay +;;;; with the window taken out: a sleep, then the agent, then an ordinary +;;;; poll loop. +;;;; +;;;; Two claims are checked against it in test_dev.ml: the session answers +;;;; while the sleep is still running, and a redefinition sent during the +;;;; sleep is installed once the program is up. +(import agent "vendor:agent") + +(defvar frames i64) + +(defn step [] i64 7) + +(defn tick [] i64 + (set frames (+ frames 1)) + frames) + +(defn main [] i32 + ;; Long enough for a test to connect, ask something and evaluate inside it, + ;; and short enough that the rest of the test is not waiting on it. + (sleep-seconds 3.0) + (agent/start "/tmp/flan-dev-lateagent-fallback.sock") + ;; dev-chatty.flan's count, for its reason: the test ends the session when + ;; it is done, and a program that ran out of frames first would fail for + ;; the wrong reason. + (dotimes [i 24000] + (tick) + (agent/wait 1)) + 0) diff --git a/test/programs/dev-parknote.flan b/test/programs/dev-parknote.flan new file mode 100644 index 0000000..5af95df --- /dev/null +++ b/test/programs/dev-parknote.flan @@ -0,0 +1,21 @@ +;;;; A program that parks the moment it is up: an agent, a line of output and +;;;; a return from main. +;;;; +;;;; Every other fixture here has to be driven to its park through the run it +;;;; was written for. What the note test needs is the park itself, repeatedly +;;;; and cheaply — a redefinition sent to a parked program is answered with an +;;;; explanation of what "queued" means for one, and the claim under test is +;;;; that the explanation is given once per park rather than once per +;;;; keystroke. So the run is as short as a run can be, and [rerun] gets it +;;;; back to a fresh park in one op. +(import agent "vendor:agent") + +(defvar runs i64) + +(defn step [] i64 7) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-parknote-fallback.sock") + (set runs (+ runs 1)) + (print runs) (println "") + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index e8cfbb2..b298696 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -3660,17 +3660,25 @@ let () = without an agent into a session that dies at startup, silently, because no test would have noticed. - So what is asserted is the policy and not the sentence: the session is - still answering after the wait ran out. The warning text is checked - second, as the evidence that this is the branch that produced it and - not some other path that happened to work. + So what is asserted is the policy and not the sentence: the session + answers. The warning text is checked second, as the evidence that this + is the branch that produced it and not some other path that happened to + work. - The block costs the full ten seconds of [merged_serve]'s [await] - ([lib/dev.ml]) and there is no way to spend less: [accept_loop] is not - reached until the wait expires, so the reply cannot arrive sooner. - Shortening it would mean a timeout override in [lib/dev.ml] that exists - for the test and for nothing else, which is a worse trade than ten - seconds in a suite that already takes minutes. *) + WHEN it answers is asserted too, and that is the newer half. The wait + for the agent socket used to sit in front of [accept_loop], so this + [describe] could not arrive until the ten seconds had run out — the + block's cost, and every real session's first keystroke. The wait is a + deadline the session passes now ([Dev.agent_check]), so the reply comes + back immediately and the sentence is said later, by the accept loop, + once the deadline is behind it. The second half is what still costs ten + seconds here: a warning about a program that is never going to start an + agent cannot honestly be said before waiting for one. + + [describe] and not a cheaper op on purpose: it is what + [emacs/flan.el] sends straight after [flan--open] (flan.el:646) and + what its poll sends after that, so this is the stall a person would + actually have felt. *) let nsock = tmp "noagent.sock" and nlog = tmp "noagent.log" in (try Sys.remove nsock with Sys_error _ -> ()); (* Its own stderr, unlike every other daemon here: the warning is the @@ -3706,11 +3714,12 @@ let () = if Sys.file_exists (nhost "s") then fail "flan dev --llvm left an x86 listing at %s" (nhost "s"); let nc = connect nsock in - (* Blocks for the whole of [merged_serve]'s wait, by construction. The - exception arm is not defensive: a session that adopted the daemon's - policy would exit here, and the connection would come back ECONNRESET - rather than with a status. Reported by name because an uncaught - [Unix_error] out of a test binary says nothing about which test. *) + (* The exception arm is not defensive: a session that adopted the + daemon's policy would exit here, and the connection would come back + ECONNRESET rather than with a status. Reported by name because an + uncaught [Unix_error] out of a test binary says nothing about which + test. *) + let nt0 = Unix.gettimeofday () in (match Wire.parse (Wire.send nc "(:op \"describe\")"; Wire.recv nc) with | r when status r = "ok" -> () | r -> @@ -3720,22 +3729,43 @@ let () = fail "a program without (agent/start ...) ended the session instead of \ drawing a warning: %s" (Printexc.to_string e)); - (try - ignore (Wire.send nc "(:op \"close\")"); - ignore (Wire.recv nc) - with _ -> ()); + let ndt = Unix.gettimeofday () -. nt0 in + (* Two seconds, against a stall that was ten and a reply that is a + fraction of one. The threshold is loose on purpose: what is being + held is "the session does not wait for the program's socket before + answering", and a number close to the real cost would fail on a + loaded machine for a reason that has nothing to do with the wait. *) + if ndt > 2. then + fail + "the first editor request waited %.1fs on a program without \ + (agent/start ...); the accept loop is gated on the agent again" + ndt; + (* Dropped rather than closed with [(:op "close")], and the difference + is the rest of this row: [close] ends the session, the process + [_exit]s, and the deadline below would be waited out by nobody. A + dropped connection leaves the accept loop cycling, which is where + the sentence is said from. *) (try Unix.close nc with Unix.Unix_error _ -> ()) end; + (* And the sentence, which arrives after the deadline rather than before + the loop. Awaited with the daemon still alive — the accept loop is what + says it, so killing first would be testing that a dead process does not + print. Generous against the ten-second deadline for the reason the + threshold above is loose. *) + let nlog_says () = + contains_sub + (try In_channel.with_open_bin nlog In_channel.input_all + with Sys_error _ -> "") + "does it call (agent/start ...)?" + in + ignore (await ~ms:30000 nlog_says); (try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ()); (try ignore (Unix.waitpid [] npid) with Unix.Unix_error _ -> ()); - let nlog_text = - try In_channel.with_open_bin nlog In_channel.input_all - with Sys_error _ -> "" - in - if not (contains_sub nlog_text "does it call (agent/start ...)?") then + if not (nlog_says ()) then fail "a program without (agent/start ...) drew no warning from flan dev:\n%s" - nlog_text; + (try In_channel.with_open_bin nlog In_channel.input_all + with Sys_error _ -> ""); List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ nsock; nlog ]; @@ -4984,6 +5014,197 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ csock; cout ]; + (* ══ The agent socket is not the editor protocol ══════════════════ + + Two daemons of their own, both about what a session owes an editor + before the program has bound the socket it receives modules on. The + row above about a program with *no* [(agent/start ...)] is the other + half of the same claim and lives where it always did. *) + + (* ── A program that starts its agent late ────────────────────────── + The shape a real one has: sand.flan opens a window and starts the + agent afterwards, so the socket appears seconds into the run. The + merged session used to wait up to ten seconds for it *before* running + its accept loop, which charged those seconds to the first thing the + editor asked. Two claims, and the second is what stops the first from + being bought with a lie: the session answers during the delay, and a + redefinition sent during it is really installed once the program is + up. *) + let lsock = tmp "lateagent.sock" and lout = tmp "lateagent.out" in + (try Sys.remove lsock with Sys_error _ -> ()); + let lfd = + Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let lpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-lateagent.flan"; "-s"; lsock |] + Unix.stdin lfd Unix.stderr + in + Unix.close lfd; + if not (listening ~pid:lpid lsock) then begin + fail "the late-agent daemon %s (%S)" !listen_why + (In_channel.with_open_bin lout In_channel.input_all); + (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let lc = connect lsock in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + (* The program sleeps for three seconds before [agent/start], so this is + asked inside the delay. Two seconds is the threshold for the reason + the agentless row gives: the reply is a fraction of one and the bug + was ten, so anything in between is a loaded machine rather than a + regression. *) + let lt0 = Unix.gettimeofday () in + let r = request lc "(:op \"describe\")" in + let ldt = Unix.gettimeofday () -. lt0 in + if status r <> "ok" then + fail "a program whose agent starts late was not described: %s" (said r); + if ldt > 2. then + fail + "the first editor request waited %.1fs on a program whose agent \ + starts late; the accept loop is gated on the agent again" ldt; + (* And the delivery, also inside the delay. It is taken — in one process + the agent's ring is reachable whether or not the program has bound a + socket — and the note says what "queued" means for a program that has + not got to its poll yet. Asserted because the alternative was the + reply this whole area exists to prevent: an "ok" that reads as + installed. *) + let r = + request lc + "(:op \"eval\" :code \"(defn step [] i64 9)\" :file \ + \"programs/dev-lateagent.flan\")" + in + if status r <> "ok" then + fail "a redefinition sent before (agent/start ...): %s" (said r) + else begin + let note = Option.value ~default:"" (Wire.string_field r "note") in + if not (contains_sub note "(agent/start ...)") then + fail + "a redefinition delivered before the program's agent was up said \ + nothing about it: %S" note + end; + (* The claim the note makes, checked against the program rather than + against the reply: once the sleep is over and the program is polling, + the body that was queued is the one that runs. [await] because the + moment the agent comes up is the program's to choose, and each + [eval-expr] already waits five seconds of its own. *) + let answered = ref "" in + let installed () = + let r = + request lc + "(:op \"eval-expr\" :code \"(step)\" :file \ + \"programs/dev-lateagent.flan\")" + in + answered := Option.value ~default:(said r) (Wire.string_field r "value"); + !answered = "9" + in + if not (await ~ms:20000 installed) then + fail + "a redefinition queued before (agent/start ...) never installed: \ + (step) answered %S" !answered; + (try + ignore (Wire.send lc "(:op \"close\")"); + ignore (Wire.recv lc) + with _ -> ()); + (try Unix.close lc with Unix.Unix_error _ -> ()); + (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] lpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ lsock; lout ]; + + (* ── The parked note, once per park ──────────────────────────────── + A finished program is parked, so re-evaluating while a run's output is + still on the screen is the commonest thing there is — and it used to + repeat a paragraph about what "queued" means for a park on every one. + The explanation is kept for the first delivery of each park and + shortened after it, which is a claim with two halves: the second note + is smaller than the first, and a *new* park gets the long one back. + The second half is why [rerun] clears the flag as well as [eval]: a run + can start and finish with nothing evaluated in between. *) + let psock = tmp "parknote.sock" and pout = tmp "parknote.out" in + (try Sys.remove psock with Sys_error _ -> ()); + let pfd = + Unix.openfile pout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let ppid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-parknote.flan"; "-s"; psock |] + Unix.stdin pfd Unix.stderr + in + Unix.close pfd; + if not (listening ~pid:ppid psock) then begin + fail "the park-note daemon %s (%S)" !listen_why + (In_channel.with_open_bin pout In_channel.input_all); + (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let pc = connect psock in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + let parked () = + match Wire.field (request pc "(:op \"describe\")") "parked" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + let redefine n = + let r = + request pc + (Printf.sprintf + "(:op \"eval\" :code \"(defn step [] i64 %d)\" :file \ + \"programs/dev-parknote.flan\")" n) + in + if status r <> "ok" then begin + fail "a redefinition of a parked program: %s" (said r); "" + end + else Option.value ~default:"" (Wire.string_field r "note") + in + (* [main] returns as soon as it has printed, so this is a wait on the + park rather than on anything this test does. *) + if not (await parked) then + fail "the park-note program never parked" + else begin + let first = redefine 1 in + let second = redefine 2 in + (* The long one by what it explains and not by its length: the + sentence about an expression taking the module first is the part + that is worth reading once. *) + if not (contains_sub first "an expression evaluated in the meantime") then + fail "the first delivery to a park did not explain itself: %S" first; + if second = "" then + fail "the second delivery to a park said nothing at all" + else if String.length second >= String.length first then + fail + "the second delivery to the same park repeated the explanation: \ + %S" second; + (* Still true, and that is the point of shortening rather than + dropping it: what the reader is told is smaller, not different. *) + if not (contains_sub second "next run") then + fail "the short park note stopped saying when it installs: %S" second; + (* A new park is a new reader. [rerun] sends the program round [main] + again and it parks straight away, with nothing evaluated in + between — which is the case [eval]'s own clearing cannot reach. *) + let r = request pc "(:op \"rerun\")" in + if status r <> "ok" then fail "the park-note rerun: %s" (said r) + else if not (await parked) then + fail "the park-note program never parked a second time" + else begin + let again = redefine 3 in + if not (contains_sub again "an expression evaluated in the meantime") + then + fail "a second park did not get the explanation back: %S" again + end + end; + (try + ignore (Wire.send pc "(:op \"close\")"); + ignore (Wire.recv pc) + with _ -> ()); + (try Unix.close pc with Unix.Unix_error _ -> ()); + (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] ppid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ psock; pout ]; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; bsock; bout ]; Test_support.report ~label:"dev" ()