From 8d49e93ab4c6e0fdb61f71419f7e90403b2dc5c0 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 27 Sep 2026 22:04:44 -0400 Subject: [PATCH] Keep subprocess timeouts, space supervisor passes, bound silent jobs proc/run's timeout overran by ~17%: jolt's timed waitFor counts its 10 ms polls instead of reading a clock. It now waits in short slices against a deadline, so 5000 ms comes back at ~5014 including the reap. The supervisor's spacing was measured from the start of a pass, so a GLM pass longer than :every-ms was followed at once by the next and the passes ran back to back through the budget; it now runs from the end. An advisory branch was exempt from every ship rung, including :answer-exists, so a supervisor's empty done was accepted. Ship rungs now say whether they bind advisory branches, and :answer-exists does, asking for a verdict. A feature, team or decompose job is one turn with no turn deadline, so a job that hung had no bound but an abort. It is now cancelled and its branch abandoned after gates.edn :job-stall-ms (30 min) with nothing journalled in the run; a job that keeps journalling runs as long as it needs. AGENTS.md now says DeepSeek flash is the machine default and that endless-flight has no config of its own. --- AGENTS.md | 11 ++++--- resources/gates.edn | 46 ++++++++++++++++++++++++------ src/samizdat/agent/beam.clj | 28 +++++++++++++++--- src/samizdat/agent/oversight.clj | 10 +++++-- src/samizdat/agent/tools/ship.clj | 25 ++++++++++------ src/samizdat/cancel.clj | 17 +++++++++++ src/samizdat/engine/proc.clj | 35 ++++++++++++++++++----- test/samizdat/base_test.clj | 5 +++- test/samizdat/beam_cancel_test.clj | 41 ++++++++++++++++++++++++++ test/samizdat/feature_test.clj | 16 +++++++++++ test/samizdat/oversight_test.clj | 37 ++++++++++++++++++++++++ test/samizdat/proc_test.clj | 15 ++++++++++ 12 files changed, 251 insertions(+), 35 deletions(-) diff --git a/AGENTS.md b/AGENTS.md index 4b12f607..19174328 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -197,10 +197,13 @@ at 2048 tokens a turn, the vendor's sampling, and the vision projector. The machine-wide config (`~/.config/samizdat/config.edn`) declares it as the `:bonsai` provider (`:type :local`) with the knobs sized for it: `:thinking? true`, `:gen-floor-tps 15`, `:max-tokens 8192`, `:read-timeout-overhead-ms -120000`, `:max-response-ms 870000`, and selects it with `:roles {:default -:bonsai}`. A `:roles :default` in any file beats `HARNESS_PROVIDER`, so a -project that wants GLM says `{:roles {:default :glm}}` in its own -`.samizdat/config.edn`, as endless-flight does. +120000`, `:max-response-ms 870000`. Since 2026-09-25 it no longer selects +it: `:roles {:default :deepseek-flash}` makes DeepSeek flash the default, and +Bonsai is a switch away — `/model bonsai` for a run, or `{:roles {:default +:bonsai}}` in a project's `.samizdat/config.edn`. A `:roles :default` in any +file beats `HARNESS_PROVIDER`, so that project file is how one project runs +on a different model than the machine's default. endless-flight has none and +runs on the machine's. What was measured on this M1 Max, and what it costs a run: decode is 20 tok/s on short replies and 14-17 on long ones; prefill is 135 tok/s, so the diff --git a/resources/gates.edn b/resources/gates.edn index 361a49ce..d0d25b08 100644 --- a/resources/gates.edn +++ b/resources/gates.edn @@ -297,6 +297,20 @@ supervisor before :provider-error-limit abandoned them. False starts the run anyway and leaves the outage to that limit."} + :job-stall-ms + {:value 1800000 :kind :threshold :capability-tunable? false + :provenance ["karamazov-abzd" "sweep5 run 2"] + :doc "How long a NON-ITERATING manifest's job (feature, team, decompose — + the whole job is one turn, so there is no turn deadline) may go + without anything journalled anywhere in the run before it is + cancelled and its branch abandoned. A bound on silence rather than + length: a job may run for hours while it keeps journalling. Run + sweep5/2 went quiet for twenty minutes and only a rig outside the + harness stopped it. Twice the turn deadline, the same line the run + detail's stalled flag draws, so a single slow model call inside the + job never trips it. Absent (a project's older gates.edn), a job has + no bound but an abort."} + :run-error-frames {:value 12 :kind :threshold :capability-tunable? false :provenance ["run ab935047" "karamazov-ma00"] @@ -1256,7 +1270,8 @@ :poll-ms 5000 ;; A pass may be a model call, so the spacing is minutes and the ;; budget is small. The stream is meant to be the thing that - ;; notices, not the thing that runs. + ;; notices, not the thing that runs. The spacing runs from the END + ;; of one pass to the start of the next. :every-ms 120000 :budget 12 ;; The read timeout for the supervisor's OWN model calls, in ms; @@ -3139,8 +3154,15 @@ ;; of its own eval and shell calls (ship.clj observed-output) — beside any ;; artifacts; before that was added the rung checked a branch's figures ;; against its siblings' accepted answers and nothing else (karamazov-3s54). + ;; An advisory branch (reviewer, supervisor) delivers a verdict that quotes + ;; the run's own figures, so only the rungs marked :advisory? true bind it; + ;; `advisory?` is in scope for a rung's forms. {:value [{:name :answer-exists + ;; The one rung an advisory branch (reviewer, supervisor) is held to: + ;; its verdict is its product, and run 9ead0638's supervisor called done + ;; with {} and was told "Answer accepted." (karamazov-qtj5). + :advisory? true :when (str/blank? (str answer)) ;; Shows the CALL, not just the missing name. base/missing already works ;; this way, on the reasoning that a bare list of argument names teaches @@ -3150,13 +3172,21 @@ ;; cost two live runs: both did the work, passed their tests, closed ;; their task, then spent their remaining turns calling `done` empty and ;; ended :exhausted with nothing shipped. - :message-form (str "`done` needs an `answer` — the text a person reads as" - " the result of this run. Not a status line: say what" - " you built and what shows it works.\n\n" - "```tool-call\n" - "{\"name\": \"done\", \"args\": {\"answer\":" - " \"\"}}\n" - "```")} + :message-form (if advisory? + (str "`done` needs an `answer` — your verdict on the run, which" + " is what this branch is for: what you found, and what" + " you did or want done about it.\n\n" + "```tool-call\n" + "{\"name\": \"done\", \"args\": {\"answer\":" + " \"\"}}\n" + "```") + (str "`done` needs an `answer` — the text a person reads as" + " the result of this run. Not a status line: say what" + " you built and what shows it works.\n\n" + "```tool-call\n" + "{\"name\": \"done\", \"args\": {\"answer\":" + " \"\"}}\n" + "```"))} {:name :figure-coverage :when (and (seq evidence) (seq uncovered-numbers)) ;; Says what COVERS a figure, not only that these are uncovered. Run diff --git a/src/samizdat/agent/beam.clj b/src/samizdat/agent/beam.clj index 4a41050f..fd71c2d1 100644 --- a/src/samizdat/agent/beam.clj +++ b/src/samizdat/agent/beam.clj @@ -593,11 +593,20 @@ The deadline is skipped for a NON-ITERATING manifest (team, feature, decompose): there a `turn` is the branch's entire job rather than one model call, so the turn deadline would abandon the run partway through the work it - was asked to do. Those runs stop by the abort flag, which is the stop path - that never depended on cooperation anyway." + was asked to do. What bounds such a job instead is SILENCE: gates.edn + :job-stall-ms of nothing journalled anywhere in the run and the job is + cancelled and its branch abandoned, saying so. A job may run for hours as + long as it keeps journalling; run sweep5/2 went quiet for twenty minutes + and nothing in the harness could stop it (karamazov-abzd). An abort + reaches a job either way: it cancels the run's task, which this wait sees." [ctx branches turn] - (let [deadline (when (get ctx :iterating-loop? true) + (let [iterating? (get ctx :iterating-loop? true) + deadline (when iterating? (or (:turn-deadline-ms ctx) (turn-deadline-ms))) + ;; nil — no key in a project's older gates.edn — is the behaviour + ;; from before the bound existed. + stall-ms (when (and (not iterating?) (:conn ctx) (:run-id ctx)) + (or (:job-stall-ms ctx) (gates/threshold :job-stall-ms))) ;; {branch-id promise} of turns cancelled at their deadline and not yet ;; terminated. A cancel is observed at the turn's next check ;; (RFC-013); until then it is still a running turn that shares the @@ -643,9 +652,20 @@ ;; Parks on the turn's SIGNAL, never on the turn task itself: ;; ebb's timeout would wait for the cancelled child, and the ;; barrier must not stall on a read the cancel cannot reach. - (let [[tag r] (cancel/await-or-cancel t deadline)] + (let [[tag r] (if stall-ms + (cancel/await-unless + t (max 1 (quot stall-ms 10)) + #(runs/stalled? (:conn ctx) (:run-id ctx) stall-ms)) + (cancel/await-or-cancel t deadline))] (case tag :ok r + :stalled + (do (log/warn "branch" (:id b) "has journalled nothing for" + stall-ms "ms on turn" turn "— cancelled") + (when cancelling (swap! cancelling assoc (:id b) (:done t))) + (assoc b :status :abandoned + :inactive-reason (str "stalled: silent " + (quot stall-ms 1000) " s"))) :timeout (do (log/warn "branch" (:id b) "exceeded the turn deadline on turn" turn "— cancelled") diff --git a/src/samizdat/agent/oversight.clj b/src/samizdat/agent/oversight.clj index 266d842b..8f3dc2a1 100644 --- a/src/samizdat/agent/oversight.clj +++ b/src/samizdat/agent/oversight.clj @@ -289,8 +289,14 @@ :boundary? (if ch (pos? (or (:turns-ended @state) 0)) true)}) - (swap! state assoc :last-at (now) :turns-ended 0) - (pass! ctx state pass-fn))) + (swap! state assoc :turns-ended 0) + (pass! ctx state pass-fn) + ;; Stamped at the END: the spacing is the gap between + ;; passes. From the start, a pass longer than the + ;; spacing — a GLM deliberation of 3-4 minutes against + ;; 2 — was due again the moment it ended, and the passes + ;; ran back to back through the budget (karamazov-qtj5). + (swap! state assoc :last-at (now)))) (catch Throwable e (when (cancel/control-signal? e) (throw e)) (log/warn "oversight loop:" (ex-message e))))) diff --git a/src/samizdat/agent/tools/ship.clj b/src/samizdat/agent/tools/ship.clj index 8e5fcb36..25eec5b6 100644 --- a/src/samizdat/agent/tools/ship.clj +++ b/src/samizdat/agent/tools/ship.clj @@ -362,7 +362,9 @@ ~'uncovered-numbers (get ~'ctx :uncovered-numbers) ;; Whether the branch's role may write: what covers a ;; figure, and so what a refusal should ask for, differs. - ~'can-write? (get ~'ctx :can-write? true)] + ~'can-write? (get ~'ctx :can-write? true) + ;; A reviewer or supervisor, whose answer is a verdict. + ~'advisory? (get ~'ctx :advisory? false)] ~form))))) (def ship-gates @@ -384,13 +386,18 @@ (defn ship-gate-block "The first lexical ship rung that fires on this evidence, or nil. Pure — - `done` computes the evidence and calls this." + `done` computes the evidence and calls this. + + On an ADVISORY branch (`:advisory?` in the evidence) only the rungs marked + `:advisory? true` apply: its answer is a verdict that quotes the run's own + figures, so the evidence rungs do not fit it, but some — that there is an + answer at all — do, and which is a gates.edn decision." [evidence] (some (fn [rung] (when ((:when rung) evidence) (let [m (:message rung)] (if (fn? m) (m evidence) m)))) - (ship-gates))) + (cond->> (ship-gates) (:advisory? evidence) (filter :advisory?)))) ;; --- the give_up rungs ------------------------------------------------------ @@ -489,12 +496,12 @@ borrowed (when (seq elsewhere) (seq (remove (set uncovered) (uncovered-tokens answer own [problem])))) - block (when-not advisory? - (ship-gate-block - {:answer answer :problem problem - :evidence evidence - :uncovered-numbers uncovered-numbers - :can-write? (roles/may-use? (:role branch) "write_file")})) + block (ship-gate-block + {:answer answer :problem problem + :evidence evidence + :uncovered-numbers uncovered-numbers + :can-write? (roles/may-use? (:role branch) "write_file") + :advisory? advisory?}) ;; The test rung — what makes the loop test-driven rather than one-shot. ;; `done` is not terminal until the unit's tests actually pass: run the ;; unit's tests, and a red / hollow / untested result is fed back so the diff --git a/src/samizdat/cancel.clj b/src/samizdat/cancel.clj index c26cdde7..c68f7d27 100644 --- a/src/samizdat/cancel.clj +++ b/src/samizdat/cancel.clj @@ -128,6 +128,23 @@ (do (cancel) [:timeout]) r))) +(defn await-unless + "Park on a started task's signal, asking `stalled?` every `slice-ms`. + Returns its [:ok v] or [:err e], or [:stalled] after asking it to stop the + first time `stalled?` answers true — detached, as `await-or-cancel` leaves a + timed-out task. The bound for work that may rightly take hours but must + not go quiet: a slice that ends is not a timeout, only a chance to look." + [{:keys [signal cancel]} slice-ms stalled?] + (loop [] + (let [r (try (ebb/? (ebb/timeout signal slice-ms ::slice)) + (catch Throwable e + (when (control-signal? e) (cancel)) + (throw e)))] + (cond + (not= ::slice r) r + (stalled?) (do (cancel) [:stalled]) + :else (recur))))) + (defn with-deadline "Run `task` and wait up to `ms` for it: [:ok v], [:err e], or [:timeout] with the task cancelled and detached. The one deadline idiom for every wait diff --git a/src/samizdat/engine/proc.clj b/src/samizdat/engine/proc.clj index ce4bfb6d..ff13b6a5 100644 --- a/src/samizdat/engine/proc.clj +++ b/src/samizdat/engine/proc.clj @@ -49,6 +49,29 @@ [pid sig] (try (c-kill pid sig) (catch Throwable _ -1))) +(def ^:private wait-slice-ms + "The longest single .waitFor inside `wait-for`: short enough that jolt's + overshoot on one slice is a few milliseconds, long enough not to spin." + 50) + +(defn- wait-for + "Whether `p` exited within `ms`, against the wall clock. + + Not one timed .waitFor: jolt's counts its 10 ms polls rather than reading a + clock, so each poll's overrun accumulates — 1000 ms came back at ~1170 and + 5000 at ~5840 on 0.8.13 (karamazov-bkjm). Short slices against a deadline + keep jolt's own wait, which parks a fiber and sees an interrupt, and bound + the overshoot to one slice's." + [^java.lang.Process p ms] + (let [deadline (+ (System/currentTimeMillis) ms)] + (loop [] + (let [left (- deadline (System/currentTimeMillis))] + (cond + (not (.isAlive p)) true + (<= left 0) false + (.waitFor p (min left wait-slice-ms) java.util.concurrent.TimeUnit/MILLISECONDS) true + :else (recur)))))) + (defn- reap! "Kill `proc`'s whole tree and do not return until the root is gone. @@ -64,8 +87,7 @@ (let [^java.lang.Process p (:proc proc) root (try (.pid p) (catch Throwable _ -1))] (doseq [pid (cons root (descendant-pids p))] (kill! pid 15)) - (when-not (try (.waitFor p sigterm-grace-ms java.util.concurrent.TimeUnit/MILLISECONDS) - (catch Throwable _ false)) + (when-not (try (wait-for p sigterm-grace-ms) (catch Throwable _ false)) ;; Still alive. SIGKILL the children BEFORE the root — enumerated now, ;; because once the root dies they reparent to init and vanish from ;; descendants(). Re-enumerated here, not reused: the tree may have @@ -73,8 +95,7 @@ (doseq [pid (descendant-pids p)] (kill! pid 9)) (kill! root 9) (try (.destroyForcibly p) (catch Throwable _ nil)) - (try (.waitFor p sigterm-grace-ms java.util.concurrent.TimeUnit/MILLISECONDS) - (catch Throwable _ nil))))) + (try (wait-for p sigterm-grace-ms) (catch Throwable _ nil))))) (defn run "Run `args` with `input` on stdin, capturing stdout and stderr. @@ -84,8 +105,8 @@ after `(get-model)` on an unsat formula even though the verdict itself was emitted cleanly, so the caller reads the output and decides. - The wait is `.waitFor` with an explicit timeout rather than a timed `deref`, - which does not work. jolt's `clojure.core/deref` forwards no opts to a record + The wait is `wait-for` — timed `.waitFor` slices against a deadline — + rather than a timed `deref`, which does not work. jolt's `clojure.core/deref` forwards no opts to a record implementing IBlockingDeref, so (deref proc ms ::timeout) silently calls the blocking one-arity and waits for however long the process takes. It fails quietly, in the direction of doing nothing: the timeout branch below was @@ -109,7 +130,7 @@ ^java.lang.Process p (:proc proc) ms (or timeout-ms 30000) finished? (try - (.waitFor p ms java.util.concurrent.TimeUnit/MILLISECONDS) + (wait-for p ms) (catch Throwable _ false))] (try (if-not finished? diff --git a/test/samizdat/base_test.clj b/test/samizdat/base_test.clj index f91f0790..f8742201 100644 --- a/test/samizdat/base_test.clj +++ b/test/samizdat/base_test.clj @@ -327,7 +327,10 @@ {:threshold {30000 "Subprocess wall-clock bound. A capability's own safety bound, not a decision about the work." 2000 "SIGTERM grace before SIGKILL. How long a dying process - gets to die, which is a property of processes."}} + gets to die, which is a property of processes." + 50 "The slice wait-for polls in, which bounds how far past + its deadline a wait can run. How precisely a timeout is + kept, not how long it is."}} "src/samizdat/events.clj" {:threshold {256 "The event tap's sliding-buffer size. RFC-009 states it as diff --git a/test/samizdat/beam_cancel_test.clj b/test/samizdat/beam_cancel_test.clj index 63d712ab..2a4fd268 100644 --- a/test/samizdat/beam_cancel_test.clj +++ b/test/samizdat/beam_cancel_test.clj @@ -15,6 +15,7 @@ [samizdat.api.control :as api-control] [samizdat.cancel :as cancel] [samizdat.store.db :as db] + [samizdat.store.journal :as journal] [samizdat.store.runs :as runs])) (defn- now [] (System/currentTimeMillis)) @@ -36,6 +37,46 @@ (defn- ctx [deadline-ms] {:iterating-loop? true :turn-deadline-ms deadline-ms :cancelling (atom {})}) +;; --- a job that goes quiet (karamazov-abzd) --------------------------------- +;; +;; A non-iterating manifest (feature, team, decompose) runs the whole job as +;; one turn, so the turn deadline is skipped — and with it every bound: run +;; sweep5/2 journalled its last event and then sat silent for twenty minutes +;; until a rig outside the harness killed it. The bound is on SILENCE, not on +;; length: a job may run for hours as long as the run keeps journalling. + +(defn- job-ctx [conn rid stall-ms] + {:iterating-loop? false :job-stall-ms stall-ms :cancelling (atom {}) + :conn conn :run-id rid}) + +(deftest a-job-that-goes-silent-is-cut-off-and-says-why + (let [c (db/open! ":memory:") + rid (runs/start-run! c {:problem "p"}) + b (state/new-branch {:id "B1" :problem "p"})] + (try + (with-redefs [beam/advance-branch (fn [_ b _] (ebb/? (ebb/sleep 60000)) b)] + (let [t0 (now) + [r] (beam/advance-all (job-ctx c rid 300) [b] 1)] + (is (< (- (now) t0) 3000) "cut off after the silence, not after the job") + (is (= :abandoned (:status r))) + (is (re-find #"(?i)silent|stall" (str (:inactive-reason r))) (str (:inactive-reason r))))) + (finally (db/close c))))) + +(deftest a-job-that-keeps-journalling-is-left-to-run + (let [c (db/open! ":memory:") + rid (runs/start-run! c {:problem "p"}) + b (state/new-branch {:id "B1" :problem "p"})] + (try + (with-redefs [beam/advance-branch (fn [_ b _] + (dotimes [i 8] + (ebb/? (ebb/sleep 100)) + (journal/note! c rid :step {:data {:i i}})) + (assoc b :finished true))] + (let [[r] (beam/advance-all (job-ctx c rid 300) [b] 1)] + (is (:finished r) "eight hundred ms of work under a 300 ms silence bound") + (is (not= :abandoned (:status r))))) + (finally (db/close c))))) + (deftest a-turn-past-the-deadline-is-cancelled-and-the-branch-forfeits-until-it-stops ;; The turn parks (a provider call would); the deadline cancels it; the park ;; sees the cancel at once, so by the next round the branch is free again. diff --git a/test/samizdat/feature_test.clj b/test/samizdat/feature_test.clj index e5df2ad8..aade7f13 100644 --- a/test/samizdat/feature_test.clj +++ b/test/samizdat/feature_test.clj @@ -266,6 +266,22 @@ (is (= :done (get-in r [:branch :status])) "the verdict lands — figures, red tree and all"))) +(deftest an-advisory-branch-still-has-to-say-something + ;; karamazov-qtj5, the second defect. Exempting advisory branches from the + ;; evidence rungs exempted them from :answer-exists too, so run 9ead0638's + ;; supervisor called done with {} and got "Answer accepted." — on a branch + ;; whose answer IS its product. The rung that binds an advisory branch says + ;; so in gates.edn, and asks for a verdict rather than for what was built. + (let [ctx {:branch (assoc (ag-state/new-branch {:id "SUP" :problem "supervise the run"}) + :advisory? true) + :config {:run {}} + :root "/nonexistent" + :tool-name "done"}] + (doseq [args [{} {:answer ""} {:answer " "}]] + (let [r (ag-tools/run-tool (assoc ctx :args args))] + (is (not= :done (get-in r [:branch :status])) (str "refused for " (pr-str args))) + (is (str/includes? (str (:result r)) "verdict") "and asked for a verdict"))))) + (deftest per-role-models-reach-each-role ;; karamazov-reo: implementor on one model, critic on another. The captured ;; :provider per role proves each role's sub-loop ran on its assigned model. diff --git a/test/samizdat/oversight_test.clj b/test/samizdat/oversight_test.clj index c84afe95..269f1702 100644 --- a/test/samizdat/oversight_test.clj +++ b/test/samizdat/oversight_test.clj @@ -84,6 +84,43 @@ (is (= :answered (first @done)) "the pass's call came back") (finally (stop))))) +(deftest passes-never-overlap + ;; karamazov-qtj5. Run 9ead0638's SUP branch interleaved two and three + ;; passes, each cold start recorded as an abandoned pass with no notes. A + ;; GLM pass deliberates for minutes, far longer than the tick; a pass that + ;; parks across many ticks must still be the only one running. + (let [in-flight (atom 0) peak (atom 0) passes (atom 0) + stop (ov/start! {:enabled? true :poll-ms 5 :every-ms 0 :budget 100 :run-id "R-overlap"} + (fn [_] + (swap! peak max (swap! in-flight inc)) + (ebb/? (ebb/sleep 80)) + (swap! in-flight dec) + (swap! passes inc) + {:carry nil :spent? true}))] + (try + (loop [n 0] (when (and (< @passes 3) (< n 300)) (Thread/sleep 10) (recur (inc n)))) + (is (<= 3 @passes) "passes keep coming") + (is (= 1 @peak) "one at a time") + (finally (stop))))) + +(deftest the-spacing-is-between-passes-not-between-their-starts + ;; :last-at was stamped when a pass STARTED, so a pass longer than + ;; :every-ms — a GLM deliberation of 3-4 minutes against 2 — was due again + ;; the moment it ended, and the passes ran back to back through the budget. + (let [spans (atom []) + stop (ov/start! {:enabled? true :poll-ms 5 :every-ms 150 :budget 100 :run-id "R-gap"} + (fn [_] + (let [t0 (System/currentTimeMillis)] + (ebb/? (ebb/sleep 200)) + (swap! spans conj [t0 (System/currentTimeMillis)]) + {:carry nil :spent? true})))] + (try + (loop [n 0] (when (and (< (count @spans) 2) (< n 300)) (Thread/sleep 10) (recur (inc n)))) + (let [[[_ end1] [start2 _]] @spans] + (is (some? start2) "a second pass ran") + (is (>= (- start2 end1) 140) (str "the gap was " (- start2 end1) " ms against a spacing of 150"))) + (finally (stop))))) + (deftest a-branch-whose-provider-keeps-failing-stops ;; The route used to see only the turn cap, so a pass whose every call ;; failed ran to it: 2810 supervisor turns against a server that was down diff --git a/test/samizdat/proc_test.clj b/test/samizdat/proc_test.clj index 0b0e05c7..13f47ec6 100644 --- a/test/samizdat/proc_test.clj +++ b/test/samizdat/proc_test.clj @@ -93,3 +93,18 @@ (let [after (open-fds)] (is (<= after (+ before 4)) (str "held " before " before and " after " after five timeouts"))))) + +(deftest a-timeout-is-the-time-it-names + ;; karamazov-bkjm. jolt's timed .waitFor counts its 10 ms polls instead of + ;; reading a clock, so every poll's overrun accumulates: measured on 0.8.13, + ;; 1000 ms came back at ~1170 and 5000 at ~5840. proc/run is the bound on + ;; every subprocess the harness spawns, so a 10-minute verify bound was + ;; nearly 12. The reap after the timeout is not part of the bound. + (sweep!) + (try + (let [t0 (System/currentTimeMillis) + r (proc/run {:timeout-ms 2000} "sh" "-c" (str "exec " needle)) + waited (- (System/currentTimeMillis) t0)] + (is (:timeout r)) + (is (< waited 2150) (str "asked for 2000 ms, waited " waited))) + (finally (sweep!))))