diff --git a/deps.edn b/deps.edn index 81373e6..52b6870 100644 --- a/deps.edn +++ b/deps.edn @@ -23,8 +23,8 @@ ;; (RFC-013, karamazov-3cll.10). jolt-lang/http-client {:git/url "https://github.com/jolt-lang/http-client" - :git/tag "v0.0.8" - :git/sha "ccce992d6e3d0035a5ffd1d4364cdb39df4af2f0"} + :git/tag "v0.0.17" + :git/sha "77d7e310a1aab2c7d5ecc9f6cc10f77b7a7f23ba"} ;; the HTTP server: HTTP/1.1 over BSD sockets through jolt.ffi, with a ;; worker pool (a long request no longer holds /health) and channel @@ -35,8 +35,8 @@ ;; and :port 0 picks a free port. jolt-lang/ring-chez-adapter {:git/url "https://github.com/jolt-lang/ring-chez-adapter" - :git/tag "v0.7.8" - :git/sha "124a7399641e409a52a73d2eaa072f031ebbbe38"} + :git/tag "v0.7.10" + :git/sha "8c93fa6fadad917f488358392d496752759a53e6"} ;; the HTTP server's routing: a table of route maps, best-match (a ;; literal segment beats a parameter), no dependencies of its own. @@ -66,7 +66,8 @@ ;; reconciles the duplicate libssl/libcrypto natives to a single load. jolt-lang/jolt-crypto {:git/url "https://github.com/jolt-lang/jolt-crypto" - :git/sha "584a4d32094f0a72613d028deb944de00cd9fc11"} + :git/tag "v0.0.9" + :git/sha "bd19a06c81c92911dbc637b865772c15e1204b05"} org.clojure/data.json {:git/url "https://github.com/clojure/data.json" diff --git a/resources/gates.edn b/resources/gates.edn index ff2f5d0..f74cf78 100644 --- a/resources/gates.edn +++ b/resources/gates.edn @@ -1166,7 +1166,18 @@ deliberate choice rather than a mistake."} :exam-ratchet - {:value {:mode :detect :min-drop 2} + {:value {:mode :detect :min-drop 2 + ;; THE RATCHET AT DONE (karamazov-fgsb, owner's decision + ;; 2026-09-29): every test that existed when the run started and + ;; is not in the tree unchanged must be explained in done's + ;; `changed_tests`, or done is refused. :explain or :off. + :at-done :explain + ;; The top-level forms that are tests, compared whole: deftest, and + ;; def for the tables tests read (a deleted row is a weaker test). + :test-def-heads ["deftest" "defspec" "def"] + ;; Files read as forms; any other test file is compared by its + ;; assertion lines (wordlists :exam :assertion-forms). + :clojure-exts [".clj" ".cljc" ".cljs"]} :kind :policy :capability-tunable? false :provenance ["karamazov-fgsb"] :doc "WHAT HAPPENS WHEN A WRITE TAKES ASSERTIONS OUT OF A TEST FILE. @@ -3310,6 +3321,23 @@ "{\"name\": \"done\", \"args\": {\"answer\":" " \"\"}}\n" "```"))} + {:name :checklist + ;; karamazov-dsfx: an answer silent on a requirement shipped, because + ;; no rung knew what the requirements WERE. The checklist is data that + ;; exists before the work (acceptance criteria, the held task's tests, + ;; what plan declared, the problem's list items — ship.clj decides + ;; which apply, :ship-checklist says how), and every item needs an + ;; entry by id: met, not met or n/a, with a reason. A not-met ships — + ;; an honest limit is a result (karamazov-ylte.1); silence does not. + :when (seq unaccounted-checklist) + :message-form (checklist/refusal unaccounted-checklist) + :provenance ["karamazov-dsfx"]} + {:name :exam-ratchet + ;; karamazov-fgsb: a run may change or delete a test that was there + ;; when it started, and must say why (:exam-ratchet :at-done). + :when (seq unexplained-tests) + :message-form (exam/refusal unexplained-tests) + :provenance ["karamazov-fgsb"]} {:name :figure-coverage :when (and (seq evidence) (seq uncovered-numbers)) ;; Says what COVERS a figure, not only that these are uncovered. Run @@ -3398,6 +3426,38 @@ :doc "The lexical ship rungs (drg-4026 #44) — adding a rung is a data edit; the evidence computation stays in ship.clj."} + :ship-checklist + {:value + {;; A list item: "- x", "* x", "+ x", "1. x", "2) x". The first group is + ;; the item's text. Lines inside a ``` fence are skipped. + :list-item-regex "^\\s{0,3}(?:[-*+]|\\d{1,2}[.)])\\s+(\\S.*)$" + ;; The words an entry's status may be, lower-cased, runs of space and _ + ;; folded to one space. + :statuses {:met ["met" "done" "yes"] + :not-met ["not met" "not-met" "unmet" "no" "partial" "partly met" "blocked"] + :n-a ["n/a" "na" "n-a" "not applicable" "out of scope"]} + ;; How each status reads on the shipped answer's checklist. + :labels {:met "met" :not-met "NOT MET" :n-a "n/a"} + ;; The sources only a branch holding NO task answers for: the run's own + ;; criteria. A board piece answers for its task (its contract's list + ;; items, its tests) and its plan. + :run-level #{:acceptance}} + :kind :policy :capability-tunable? false + :provenance ["karamazov-dsfx"] + :doc "THE SHIP CHECKLIST (samizdat.agent.checklist). `done` refuses an + answer that does not account for every checklist item by id. The + items: the operator's :run :acceptance criteria (a1..), the held + task's :tests when it is prose, not a path (t1), what the branch + declared with plan's `checklist` (c1.., a re-plan adds and never + drops), and the list items of what the branch was asked (p1..: the + run's problem, or a board piece's task contract — a contract with no + list items is itself p1). Acceptance items bind only a branch that + works no task (:run-level); a board revision branch works the task + it carries. An + advisory branch owes none. Each entry is met / not met / n/a with a + reason; the accounted list is appended to the shipped answer so the + critic reads the claims."} + :give-up-reason-floor {:value 60 :kind :threshold :capability-tunable? false :provenance ["karamazov-ylte.1" "run dbe64eea-successor"] @@ -4279,13 +4339,28 @@ :goal {:type "string" :description "One or two sentences: what the change does and how it meets the whole ask."} :rfc {:type "string" - :description "The RFC document in markdown, when this step asked for one."}} + :description "The RFC document in markdown, when this step asked for one."} + :checklist {:type "array" :items {:type "string"} + :description "The requirements this change commits to, one sentence each; done accounts for each by id (c1, c2, ...)."}} :required ["files" "goal"]}} "done" {:name "done" :description "Finish the task and return the final answer." :parameters {:type "object" :properties {:answer {:type "string" - :description "The final answer, or the best partial result so far."}} + :description "The final answer, or the best partial result so far."} + :checklist {:type "array" + :items {:type "object" + :properties {:item {:type "string" :description "The requirement's id: p1, a1, t1, c1, ..."} + :status {:type "string" :enum ["met" "not_met" "n/a"]} + :evidence {:type "string" :description "What shows it, or why it is not met."}} + :required ["item" "status" "evidence"]} + :description "One entry per requirement owed, by id."} + :changed_tests {:type "array" + :items {:type "object" + :properties {:test {:type "string" :description "The test's name, or the file's path for a file that is not Clojure."} + :reason {:type "string" :description "Why it changed or went, and what pins the behaviour now."}} + :required ["test" "reason"]} + :description "One entry per pre-existing test this change altered or deleted."}} :required ["answer"]}} "give_up" {:name "give_up" :description "Abandon the task, stating why it cannot be finished." diff --git a/resources/manual.edn b/resources/manual.edn index d2adae2..4f2d6d6 100644 --- a/resources/manual.edn +++ b/resources/manual.edn @@ -440,6 +440,14 @@ :summary "Run criteria with an injected shell and judge; one {:name :kind :passed? :output} per criterion, in order. :passed? nil is undecided (not run, or a judge with no verdict) and does not block — fail-open like every judge here. `done` runs the :check criteria (model-free, like the rest of that gate); :feature/verify runs both kinds as Gate 2's other half. Results are journalled per criterion under :acceptance with :at done|verify."} {:name samizdat.agent.acceptance/refusal :summary "What the branch reads when criteria failed: each by name with the failure's own words, and what was met. prompts/acceptance-failed.md."} + {:name samizdat.agent.checklist/items + :summary "The ship checklist (karamazov-dsfx): what a `done` answer must account for, item by item, as [{:id :text :source}] — a1.. the acceptance criteria (a branch holding no task only), t1 the held task's :tests when it is prose (its first paragraph), c1.. what the branch declared with plan's `checklist` (a re-plan adds, never drops: state/declare-checklist), p1.. the list items of what the branch was asked (the run's problem, or a board piece's task contract — a contract with no list items is itself p1; fenced code skipped). A board revision branch works the task it carries, so it owes that task and not the run's criteria. The :checklist rung in gates.edn :ship-gates refuses an answer missing an entry; policy is gates.edn :ship-checklist."} + {:name samizdat.agent.checklist/entries + :summary "done's `checklist` argument as {id {:status :evidence}}: a vector of {item, status, evidence} or a map by id, or either as JSON. Status met / not_met / n/a (synonyms in :ship-checklist :statuses); an entry needs a known status and a non-blank reason or it counts as silence (`unaccounted`). A not_met ships — an honest limit is a result. The accounted list is appended to the shipped answer (prompts/checklist-answer.md), its evidence read by the figure rung, and journalled under :checklist."} + {:name samizdat.agent.exam/touched + :summary "The exam ratchet at done (karamazov-fgsb): every test that existed at the run's git baseline and is not in the tree unchanged, as [{:path :test :kind :deleted|:changed :after-hash}]. Clojure test files are compared as whole top-level forms (gates.edn :exam-ratchet :test-def-heads — deftest, defspec, def), reader gensyms folded, and a test moved to another file is not touched; any other file by its assertion lines. The :exam-ratchet ship rung refuses done until done's `changed_tests` gives a reason for each (exam/explanations); a reason journalled earlier in the run (:tests-explained) for the same state of the test counts. The reasons are appended to the shipped answer."} + {:name samizdat.agent.gitdiff/file-at + :summary "A file's content in the run's baseline commit (untracked files included), or nil when it was not there: the tree as the run found it."} {:name samizdat.agent.judge/parse-yesno :summary "true / false / nil from a narrow judge reply — the first word of the first line, else of the last. The shape prompts/acceptance-judge.md asks for; change both together."} {:name samizdat.agent.judge/parse-criteria diff --git a/resources/prompts/checklist-answer.md b/resources/prompts/checklist-answer.md new file mode 100644 index 0000000..bb2e6eb --- /dev/null +++ b/resources/prompts/checklist-answer.md @@ -0,0 +1,5 @@ + + +Checklist: +{% for r in rows %}- {{r.id}} [{{r.label}}] {{r.text}} — {{r.evidence}} +{% endfor %} diff --git a/resources/prompts/checklist-missing.md b/resources/prompts/checklist-missing.md new file mode 100644 index 0000000..5576f99 --- /dev/null +++ b/resources/prompts/checklist-missing.md @@ -0,0 +1,5 @@ +This answer does not account for every item on the checklist. The checklist is what this work was asked to deliver, fixed before it started, and an item the answer is silent on reads as done when nobody said so. Account for each one below by its id: + +{% for i in missing %}- **{{i.id}}** {{i.text}} +{% endfor %} +Call `done` again with your answer and a `checklist` entry for every item: `"checklist": [{"item": "{{missing.0.id}}", "status": "met", "evidence": "what shows it: the test, the command and what it printed"}, …]`. The status is `met`, `not_met` or `n/a`. An item you could not finish is `not_met` with the reason — that ships, and it is the honest answer. Leaving it out does not. diff --git a/resources/prompts/plan-tool.md b/resources/prompts/plan-tool.md index b8d6ae1..e98621e 100644 --- a/resources/prompts/plan-tool.md +++ b/resources/prompts/plan-tool.md @@ -1,4 +1,6 @@ -{% if not-a-path %}plan refused: "{{not-a-path}}" is not a file path. Every entry in files and tests is a bare relative path — test/flight/ghost_test.clj, not the path with a description after it — because a declared file is what you are held to when you finish, and a sentence can never be written. Put descriptions in goal and call plan again with paths only.{% endif %}{% if needs-files %}plan needs at least one file: {"files": ["src/…"], "tests": ["test/…"], "goal": "…"}. Naming a file is the point — it is your hypothesis about where the problem is, and it is what you will be held to when you finish.{% endif %}{% if declared %}{% if planning %}Plan recorded{% if goal %} — {{goal}}{% endif %}. It names: {{files}}. +{% if not-a-path %}plan refused: "{{not-a-path}}" is not a file path. Every entry in files and tests is a bare relative path — test/flight/ghost_test.clj, not the path with a description after it — because a declared file is what you are held to when you finish, and a sentence can never be written. Put descriptions in goal and call plan again with paths only.{% endif %}{% if needs-files %}plan needs at least one file: {"files": ["src/…"], "tests": ["test/…"], "goal": "…"}. Naming a file is the point — it is your hypothesis about where the problem is, and it is what you will be held to when you finish.{% endif %}{% if declared %}{% if checklist %}Checklist recorded, {{checklist}} in all (c1…): `done` must carry an entry for each one. + +{% endif %}{% if planning %}Plan recorded{% if goal %} — {{goal}}{% endif %}. It names: {{files}}. This planning step is complete. A reviewer reads the plan against the requirement next; if it is sent back, you will be asked to revise it. Nothing further is needed from you here.{% else %}Plan recorded{% if goal %} — {{goal}}{% endif %}. You will land: {{files}}. diff --git a/resources/prompts/system-tools.md b/resources/prompts/system-tools.md index c295555..4e0feea 100644 --- a/resources/prompts/system-tools.md +++ b/resources/prompts/system-tools.md @@ -10,12 +10,21 @@ branch_theses({theses}) Propose up to 4 competing plans. The first commits this branch; the rest become sibling branches that explore independently and share your failure log, so none of you repeats another's dead end. -done({answer}) +done({answer, checklist?, changed_tests?}) Ship. `answer` is REQUIRED and is the run's actual output — the text a person reads to learn what you did and why they should believe it. A `done` with no answer is refused and costs you the turn. Also refused if the answer states figures nothing in the evidence supports, or engages nothing the problem asked. + `checklist` accounts for each requirement you owe, by its id: + [{"item": "p1", "status": "met" | "not_met" | "n/a", "evidence": "…"}]. + The requirements are the list items in the problem (p1…), the operator's + acceptance criteria (a1…), your task's tests (t1) and what you declared + with plan (c1…). A requirement left out is refused; one you could not + meet ships as not_met with the reason. + `changed_tests` says why each test that existed when the run started was + changed or deleted: [{"test": "blank-titles", "reason": "…"}]. A test + changed without a reason is refused. give_up({reason}) Stop working this line and say why. ``` @@ -23,9 +32,10 @@ give_up({reason}) ### Developing at the REPL ``` -plan({files, tests?, goal?, rfc?}) +plan({files, tests?, goal?, rfc?, checklist?}) Say which files you are about to create or edit, which tests you will - write, and why — one line. When the design step asks for an RFC, `rfc` + write, and why — one line. `checklist` lists the requirements you are + committing to, one sentence each; `done` will ask you for each by id. When the design step asks for an RFC, `rfc` carries the whole document; it is what the reviewer reads. Every entry in files and tests is a bare relative path such as test/flight/ghost_test.clj, nothing else: a path with a description after it is refused, because a declared file is what diff --git a/resources/prompts/tests-explained.md b/resources/prompts/tests-explained.md new file mode 100644 index 0000000..db19008 --- /dev/null +++ b/resources/prompts/tests-explained.md @@ -0,0 +1,5 @@ + + +Tests changed from the run's start: +{% for r in rows %}- {{r.key}} ({{r.path}}, {{r.kind}}) — {{r.reason}} +{% endfor %} diff --git a/resources/prompts/tests-unexplained.md b/resources/prompts/tests-unexplained.md new file mode 100644 index 0000000..0d18641 --- /dev/null +++ b/resources/prompts/tests-unexplained.md @@ -0,0 +1,5 @@ +This change alters tests that were there when the run started, and the answer does not say why. A test is the definition of done that existed before this work; changing it to get green and changing it because it was wrong look the same in a diff, and only you can say which it was. + +{% for t in missing %}- **{{t.key}}** ({{t.path}}) — {{t.kind}} +{% endfor %} +If a change was not meant, put the test back. Otherwise call `done` again with a `changed_tests` entry for each: `"changed_tests": [{"test": "{{missing.0.key}}", "reason": "what was wrong with the old test, or where it went, and what now pins the behaviour"}, …]`. diff --git a/resources/userspace.edn b/resources/userspace.edn index 948672a..524b4e4 100644 --- a/resources/userspace.edn +++ b/resources/userspace.edn @@ -59,6 +59,10 @@ {:acceptance-failed "prompts/acceptance-failed.md" :abandoned-reason "prompts/abandoned-reason.md" :acceptance-judge "prompts/acceptance-judge.md" + :checklist-answer "prompts/checklist-answer.md" + :checklist-missing "prompts/checklist-missing.md" + :tests-explained "prompts/tests-explained.md" + :tests-unexplained "prompts/tests-unexplained.md" :adopt-tool "prompts/adopt-tool.md" :battery-tool "prompts/battery-tool.md" :heldout-decided "prompts/heldout-decided.md" diff --git a/src/samizdat/agent/checklist.clj b/src/samizdat/agent/checklist.clj new file mode 100644 index 0000000..4234349 --- /dev/null +++ b/src/samizdat/agent/checklist.clj @@ -0,0 +1,182 @@ +;; samizdat - a self-hosting agentic harness +;; Copyright (C) 2026 Dmitri Sotnikov +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +(ns samizdat.agent.checklist + "The ship checklist (karamazov-dsfx): what an answer must account for, + item by item. + + WHY. A requirement could ship by being left out of the answer. The lexical + rungs catch an answer that CONFESSES unfinished work; an answer that is + simply silent on a requirement passed every one, and the critic caught it a + whole round (~90 turns) later. Deciding from prose that a requirement went + unaddressed is a judgement — measured 2026-09-29 with lev on 50 real + cases: the BERT encoders never once answered 'absent', and Qwen3.5-4B + called four of five silent answers 'met' at 0.95-1.0 confidence. + + So the judgement is removed rather than made. The checklist is data that + exists before the work — the operator's acceptance criteria, the held + task's tests, what the branch declared with `plan`, the problem's own list + items — and `done` must carry one entry per item, by id: met, not met, or + not applicable, each with a reason. Silence becomes a missing key. Whether + a `met` is true stays with the evidence rungs and the critic, who read the + entries on the shipped answer. + + MECHANISM ONLY. Which sources apply to which branch is the done handler's + and gates.edn :ship-checklist's; the wording is prompts/checklist-*.md." + ;; samizdat.prompt first: it loads jolt.time, which data.json needs. + (:require [samizdat.prompt :as prompt] + [clojure.data.json :as json] + [clojure.string :as str] + [samizdat.agent.gates :as gates] + [samizdat.agent.verify :as verify])) + +(defn policy [] (gates/threshold :ship-checklist)) + +;; --- the items ---------------------------------------------------------------- + +(defn problem-items + "The list items of a problem statement, in order: each line policy's + :list-item-regex matches, its first group trimmed. Lines inside a fenced + code block are code, not requirements." + [text] + (let [re (re-pattern (:list-item-regex (policy)))] + (loop [[line & more :as lines] (str/split-lines (str text)) fenced? false out []] + (cond + (empty? lines) out + (str/starts-with? (str/triml line) "```") (recur more (not fenced?) out) + fenced? (recur more fenced? out) + :else (recur more fenced? + (if-let [[_ item] (re-find re line)] + (conj out (str/trim item)) + out)))))) + +(defn- first-paragraph [s] (str/trim (first (str/split (str s) #"\n\s*\n")))) + +(defn- problem-list + "`problem`'s list items; with `whole?` and none, its first paragraph as the + one item. A board piece's contract is usually a single line — the RFC's + work item — and then the contract itself is what the piece owes (run + 582980ef: three pieces shipped owing nothing)." + [problem whole?] + (let [its (when problem (problem-items problem))] + (cond (seq its) its + (and whole? (not (str/blank? (str problem)))) [(first-paragraph problem)] + :else []))) + +(defn items + "Every item owed, as `[{:id :text :source}]`, ids by source — a1.. the + acceptance criteria, t1 the held task's tests, c1.. what `plan` declared, + p1.. the list items of what the branch was asked (the run's problem, or a + board piece's task contract). Every argument is optional; the caller + passes only the sources that apply to the branch. + + `whole-problem?` makes a problem with no list items one item, its first + paragraph: set for a branch that works a task, whose problem is a contract. + + A task's :tests that is a test PATH is not an item: it is judged by running + it (the verify rung), not by the answer saying so." + [{:keys [acceptance task-tests declared problem whole-problem?]}] + (let [tag (fn [prefix source texts] + (map-indexed (fn [i t] {:id (str prefix (inc i)) :text t :source source}) texts)) + ;; Its first paragraph: the board writes a standing paragraph of + ;; testing guidance here, and the item is its first sentence group, + ;; not the essay after it. + task (when-let [t (some-> task-tests str str/trim not-empty)] + (when-not (verify/test-file? t) + [(first-paragraph t)]))] + (vec (concat (tag "a" :acceptance (map #(if (= :judge (:kind %)) (:text %) (:name %)) acceptance)) + (tag "t" :task task) + (tag "c" :declared (remove str/blank? (map str declared))) + (tag "p" :problem (problem-list problem whole-problem?)))))) + +;; --- the answer's entries ----------------------------------------------------- + +(defn- status-of + "`s` as :met / :not-met / :n-a by policy's :statuses, or nil." + [s] + (let [k (-> (str s) str/trim str/lower-case (str/replace #"[\s_]+" " "))] + (some (fn [[status words]] (when (contains? (set words) k) status)) + (:statuses (policy))))) + +(defn- field [m & ks] + (some #(let [v (or (get m %) (get m (name %)))] (when (some? v) v)) ks)) + +(defn entries + "The `checklist` argument of `done` as `{id {:status :evidence}}`, id + lower-cased. Read leniently: a vector of `{item|id, status, evidence|note| + reason}` maps, a map keyed by id, or either as a JSON string. Anything else + is no entries — never an error, since the missing items are what the + refusal will name. A status off the menu is kept as nil so it counts as + unaccounted rather than vanishing." + [raw] + (let [raw (if (string? raw) (try (json/read-str raw) (catch Throwable _ nil)) raw) + one (fn [id m] + (let [m (if (map? m) m {:status m})] + [(str/lower-case (str/trim (str id))) + {:status (status-of (field m :status)) + :evidence (str/trim (str (or (field m :evidence :note :reason) "")))}]))] + (cond + (map? raw) (into {} (map (fn [[k v]] (one (name k) v))) raw) + (sequential? raw) (into {} (keep #(when (map? %) + (when-let [id (field % :item :id)] (one id %)))) + raw) + :else {}))) + +(defn- plain [s] (-> (str s) str/trim str/lower-case (str/replace #"[.\s]+$" ""))) + +(defn- entry-for + "`item`'s entry: by its id, else by its exact text — case and a closing + full stop aside. Run 6e3eda8a's model named items by sentence; a + paraphrase is still not the item." + [entries {:keys [id text]}] + (or (get entries (str/lower-case id)) + (some (fn [[k e]] (when (= (plain k) (plain text)) e)) entries))) + +(defn unaccounted + "The items with no entry that has a known status and a non-blank reason." + [items entries] + (filterv (fn [item] + (let [{:keys [status evidence]} (entry-for entries item)] + (or (nil? status) (str/blank? evidence)))) + items)) + +;; --- rendering ---------------------------------------------------------------- + +(defn- rows [items entries] + (mapv (fn [{:keys [id text] :as item}] + (let [{:keys [status evidence]} (entry-for entries item)] + {:id id :text text :status (some-> status name) :evidence evidence + :label (get (:labels (policy)) status "?")})) + items)) + +(defn render + "The accounted checklist as text to append to the shipped answer." + [items entries] + (prompt/render "checklist-answer" {:rows (rows items entries)})) + +(defn refusal + "The ship refusal naming each unaccounted item." + [missing] + (prompt/render "checklist-missing" {:missing missing})) + +(defn record + "The checklist as a journal value: items, and entries as a vector (a + journal row is JSON, and ids as keys would come back as keywords)." + [items entries] + {:items items + :entries (mapv (fn [[id e]] (assoc e :id id :status (some-> (:status e) name))) entries)}) diff --git a/src/samizdat/agent/exam.clj b/src/samizdat/agent/exam.clj index 1eb049c..ec9bece 100644 --- a/src/samizdat/agent/exam.clj +++ b/src/samizdat/agent/exam.clj @@ -41,9 +41,12 @@ assertion deletion. `:refuse` exists in the policy so the decision can be revisited when more runs have accumulated; it is not the default. - Pure. The caller supplies the two texts; this namespace never reads a file - and never writes a journal." - (:require [clojure.string :as str] + Pure. The caller supplies the texts; this namespace never reads a file + and never writes a journal. The ratchet at `done` is further down." + ;; samizdat.prompt first: it loads jolt.time, which data.json needs. + (:require [samizdat.prompt :as prompt] + [clojure.data.json :as json] + [clojure.string :as str] [samizdat.lexicon :as lexicon])) (defn policy @@ -95,6 +98,160 @@ ([] (refuse? (policy))) ([p] (= :refuse (:mode p)))) +;; --- the ratchet at done ------------------------------------------------------ +;; +;; karamazov-fgsb, the owner's decision (2026-09-29): a run may change or +;; delete a test that existed when it started, and must SAY WHY. At `done` +;; the harness compares each changed test file with the run's baseline and +;; names every pre-existing test the tree no longer holds unchanged; the +;; answer explains each or `done` is refused. A false alarm costs one line +;; of explanation, not the work, which is what lets the detector be broad. +;; +;; WHOLE TEST FORMS, not assertion lines: on the 50 real edit_file hunks of +;; 2026-09-29 a per-line diff missed a data-table row deleted, a changed +;; `let` input and an assertion's continuation line. A Clojure file is read +;; as forms; a file that does not read (another language, a reader feature +;; this image lacks) falls back to its assertion lines. + +(defn- clojure-source? [path] + (some #(str/ends-with? (str path) %) (:clojure-exts (policy)))) + +(defn- normal + "A form's printed text with reader gensyms folded: a fn literal reads with + fresh `p__N#` names every time, and syntax quote with `x__N__auto`." + [form] + (str/replace (pr-str form) #"__\d+" "__")) + +(defn test-forms + "`{name normalized-text}` for the top-level forms of `text` whose head is + one of policy's :test-def-heads (deftest, and def for the tables tests + read), or nil when `text` does not read. Blank text is no forms." + [text] + (if (str/blank? (str text)) + {} + (try + (let [heads (set (:test-def-heads (policy))) + forms (binding [*ns* (the-ns 'user) *read-eval* false] + (read-string (str "[" text "\n]")))] + (into {} (keep (fn [f] + (when (and (seq? f) (symbol? (first f)) (contains? heads (name (first f))) + (symbol? (second f))) + [(name (second f)) (normal f)]))) + forms)) + (catch Throwable _ nil)))) + +(defn- assertion-lines + "The lines of `text` that hold an assertion, whitespace folded." + [text] + (let [pats (map re-pattern (:assertion-forms (lexicon/wordlist :exam)))] + (into #{} (comp (filter (fn [l] (some #(re-find % l) pats))) + (map #(str/trim (str/replace % #"\s+" " ")))) + (str/split-lines (str text))))) + +(defn touched + "Every test that was in a file's `:before` and is not in the tree unchanged, + over `files` — `[{:path :before :after}]`, the changed test files, before as + the run found it (nil when new) and after as it stands (nil when deleted). + + `[{:path :test :kind :deleted|:changed :after-hash}]`. A test deleted from + one file whose identical form is in another file's after MOVED and is not + touched. A file that does not read is one entry, `:test nil`, when an + assertion line it had is gone. `:after-hash` identifies what the test is + now, so an explanation given for this state is recognised later in the run." + [files] + (let [read (mapv (fn [{:keys [path before after]}] + (let [b (when (clojure-source? path) (test-forms before)) + a (when (clojure-source? path) (test-forms after))] + {:path path :before before :after after + :b b :a a :forms? (and (some? b) (some? a))})) + files) + everywhere (into #{} (mapcat #(vals (:a %))) read)] + (vec + (mapcat + (fn [{:keys [path before after b a forms?]}] + (if forms? + (keep (fn [[nm form]] + (let [now (get a nm)] + (when-not (or (= form now) (contains? everywhere form)) + {:path path :test nm :kind (if now :changed :deleted) + :after-hash (hash (str now))}))) + (sort-by key b)) + (let [was (assertion-lines before) + now (assertion-lines after)] + (when (seq (remove now was)) + [{:path path :test nil :kind :changed + :after-hash (hash (str/join "\n" (sort now)))}])))) + read)))) + +(defn- field [m & ks] + (some #(let [v (or (get m %) (get m (name %)))] (when (some? v) v)) ks)) + +(defn explanations + "done's `changed_tests` argument as `{key reason}`, key a test's name or, + for a file that does not read, its path. A vector of `{test|path, reason}` + maps, a map of key to reason, or either as a JSON string; anything else is + none." + [raw] + (let [raw (if (string? raw) (try (json/read-str raw) (catch Throwable _ nil)) raw) + one (fn [k v] [(str/trim (str k)) + (str/trim (str (if (map? v) (field v :reason :why :evidence) v)))])] + (cond + (map? raw) (into {} (map (fn [[k v]] (one (name k) v))) raw) + (sequential? raw) (into {} (keep #(when (map? %) + (when-let [k (field % :test :path :name)] + (one k %)))) + raw) + :else {}))) + +(defn- key-of [{:keys [path test]}] (or test path)) + +(defn- bare + "An explanation's key as a test name: a trailing `(file)` and a leading + `ns/` dropped, lower-cased. Run 582980ef's model named the same test as + `flight.game-test/...` and as `... (game_test.clj)`." + [k] + (-> (str k) (str/replace #"\s*\(.*\)\s*$" "") (str/replace #"^.*/(?=[^/]+$)" "") + str/trim str/lower-case)) + +(defn- reason-for + "The reason `explained` gives for touched test `t`: its exact key, else an + entry whose bare name is the test's." + [explained t] + (or (not-empty (get explained (key-of t))) + (when-let [nm (:test t)] + (some (fn [[k r]] (when (and (= (str/lower-case nm) (bare k)) (not (str/blank? r))) r)) + explained)))) + +(defn unexplained + "The `touched` tests with no non-blank reason in `explained` and not in + `prior` — the `[path test after-hash]` triples explained earlier in the run + for the same state of the test." + ([touched explained] (unexplained touched explained #{})) + ([touched explained prior] + (filterv (fn [t] + (and (str/blank? (reason-for explained t)) + (not (contains? prior [(:path t) (:test t) (:after-hash t)])))) + touched))) + +(defn explained-record + "What a ship journals so a later branch is not asked again: each touched + test with its reason." + [touched explained prior] + (vec (keep (fn [t] + (when-let [r (not-empty (reason-for explained t))] + (assoc (select-keys t [:path :test :kind :after-hash]) :reason r))) + touched))) + +(defn refusal [missing] + (prompt/render "tests-unexplained" + {:missing (mapv #(assoc % :key (key-of %) :kind (name (:kind %))) missing)})) + +(defn render [touched explained prior] + (prompt/render "tests-explained" + {:rows (vec (keep (fn [t] (when-let [r (not-empty (reason-for explained t))] + (assoc t :key (key-of t) :kind (name (:kind t)) :reason r))) + touched))})) + (defn describe "One line for the record: what the file lost." [path {:keys [before after drop]}] diff --git a/src/samizdat/agent/gitdiff.clj b/src/samizdat/agent/gitdiff.clj index 56a2e32..345a4c1 100644 --- a/src/samizdat/agent/gitdiff.clj +++ b/src/samizdat/agent/gitdiff.clj @@ -123,6 +123,16 @@ str/trim not-empty)} (porcelain-counts (git root "status" "--porcelain"))))) +(defn file-at + "`path`'s content in the `baseline` commit, or nil when it was not there + (or there is no git). The baseline commit holds untracked files too, so + this is the file as the run found it — what the exam ratchet compares a + test file against (karamazov-fgsb)." + [root baseline path] + (when (and root baseline path) + ;; `./` makes the path the project root's, as git -C runs from there. + (git root "show" (str baseline ":./" path)))) + (defn changed-files "The paths the run changed since `baseline`: tracked edits (git diff --name-only) UNION new files (git ls-files --others). The union matters — @@ -134,7 +144,10 @@ anything." [root baseline] (when (and root baseline) - (let [tracked (lines (git root "diff" "--name-only" baseline)) + ;; --relative: paths from the project root, and only the files under + ;; it. Without it git names paths from the REPOSITORY top, so a project + ;; in a subdirectory of a repo read its edits as paths it did not have. + (let [tracked (lines (git root "diff" "--name-only" "--relative" baseline)) {:keys [stale created]} (untracked-split root baseline)] ;; nil only when git could not answer (cannot tell); otherwise the ;; union, which may be empty (genuinely nothing changed). An untracked @@ -165,7 +178,7 @@ (when (and root baseline) (let [num (fn [s] (or (parse-long (str s)) 0)) {:keys [stale created]} (untracked-split root baseline) - tracked (some->> (git root "diff" "--numstat" baseline) + tracked (some->> (git root "diff" "--numstat" "--relative" baseline) str/split-lines (remove str/blank?) (map #(str/split % #"\t")) @@ -194,7 +207,7 @@ (or (when (and root baseline) ;; Without the untracked files the baseline holds unchanged, which ;; `git diff` would show as deleted — the run did not delete them. - (some-> (apply git root "diff" baseline "--" "." + (some-> (apply git root "diff" "--relative" baseline "--" "." (map #(str ":(exclude)" %) (:stale (untracked-split root baseline)))) (as-> d (if (> (count d) (long cap)) diff --git a/src/samizdat/agent/state.clj b/src/samizdat/agent/state.clj index 4115ae2..78fac15 100644 --- a/src/samizdat/agent/state.clj +++ b/src/samizdat/agent/state.clj @@ -694,6 +694,36 @@ [branch] (:repl-plan branch)) +(defn declare-checklist + "Add `items` — requirement sentences the branch commits to — to its ship + checklist (karamazov-dsfx). A UNION kept in declaration order: a re-plan + replaces the file hypothesis, but a requirement once named stays owed, so + dropping it is not a way past `done`; saying it is not met is. + + An item that opens with a `cN:` label naming an item already declared is + a RESTATEMENT of it and adds nothing; the label is dropped from any item + that is kept. Run 582980ef's model labelled its items c1..c4 and reworded + them on every re-plan: as a plain union the list grew to c8 while it kept + answering c1..c4, and done was refused three times over items it believed + it had answered." + [branch items] + (let [have (vec (:checklist branch))] + (assoc branch :checklist + (reduce (fn [acc item] + (let [s (str/trim (str item)) + [_ n text] (re-find #"^[cC](\d+)\s*[:.)\-]\s*(.*)$" s) + text (str/trim (or text s))] + (cond (str/blank? text) acc + (and n (<= 1 (parse-long n) (count have))) acc + (some #{text} acc) acc + :else (conj acc text)))) + have items)))) + +(defn checklist + "What the branch has declared it owes, in order." + [branch] + (vec (:checklist branch))) + (defn note-write "Record that `path` was actually written, discharging it from the plan." [branch path] diff --git a/src/samizdat/agent/tools/plan.clj b/src/samizdat/agent/tools/plan.clj index c5918d6..050ccdb 100644 --- a/src/samizdat/agent/tools/plan.clj +++ b/src/samizdat/agent/tools/plan.clj @@ -33,6 +33,18 @@ :else [(str v)]))) files (coerce :files) tests (coerce :tests) + ;; Requirement sentences, not paths: what `done` will have to account + ;; for item by item (karamazov-dsfx). Kept apart from :files so the + ;; path check below does not refuse a sentence it was given here. + checklist (mapv (fn [x] + ;; Run 6e3eda8a sent [{"c1": "..."}]: a one-entry map + ;; is a labelled item, a map with :text its text. + (if (map? x) + (or (some #(get x %) [:text "text" :item "item"]) + (let [[[k v]] (seq x)] (str (name k) ": " v))) + x)) + (base/listed (or (base/arg ctx :checklist) (get (:args ctx) "checklist")))) + checklist (vec (remove empty? (map str (if (sequential? checklist) checklist [checklist])))) goal (some-> (base/arg ctx :goal) str not-empty) ;; An RFC is free prose (Purpose/Model/Work items/Acceptance, with a ;; mermaid call-graph), not a path — the design-rfc step asks for it, @@ -59,7 +71,8 @@ (base/malformed branch (msg {:needs-files true})) :else - (let [b (state/declare-plan branch {:files files :tests tests :goal goal :rfc rfc}) + (let [b (-> (state/declare-plan branch {:files files :tests tests :goal goal :rfc rfc}) + (state/declare-checklist checklist)) ;; On a PLANNING branch the declaration is the deliverable, so it ;; ends the branch — the board's design step reads the plan off the ;; finished branch. Nothing else ended it: the step ran to its cap @@ -72,5 +85,6 @@ :files (clojure.string/join ", " (:files (state/plan b))) :goal goal :rfc (boolean rfc) + :checklist (count (state/checklist b)) :planning planning?})) :branch b))))) diff --git a/src/samizdat/agent/tools/ship.clj b/src/samizdat/agent/tools/ship.clj index 25eec5b..a889e30 100644 --- a/src/samizdat/agent/tools/ship.clj +++ b/src/samizdat/agent/tools/ship.clj @@ -7,6 +7,8 @@ uncovered-tokens, engages-problem? and friends)." (:require [clojure.string :as str] [samizdat.agent.acceptance :as acceptance] + [samizdat.agent.checklist :as checklist] + [samizdat.agent.exam :as exam] [samizdat.agent.files :as files] [samizdat.agent.gitdiff :as gitdiff] [samizdat.agent.gates :as gates] @@ -364,7 +366,13 @@ ;; figure, and so what a refusal should ask for, differs. ~'can-write? (get ~'ctx :can-write? true) ;; A reviewer or supervisor, whose answer is a verdict. - ~'advisory? (get ~'ctx :advisory? false)] + ~'advisory? (get ~'ctx :advisory? false) + ;; The checklist items the answer has not accounted for + ;; (karamazov-dsfx); empty when nothing is owed. + ~'unaccounted-checklist (get ~'ctx :unaccounted-checklist) + ;; Pre-existing tests changed or deleted with no reason + ;; given (karamazov-fgsb); empty when none. + ~'unexplained-tests (get ~'ctx :unexplained-tests)] ~form))))) (def ship-gates @@ -459,6 +467,10 @@ ;; — now data-defined (gates.edn :ship-gates, drg-4026 #44). The coding ;; loop's ship gate (tests pass, review passed) rebuilds on this seam. (let [answer (base/arg ctx :answer) + ;; The answer's checklist entries (karamazov-dsfx). Their evidence is + ;; part of what the answer claims, so the figure rung reads it too. + accounted (checklist/entries (base/arg ctx :checklist)) + claimed (str/join "\n" (cons (str answer) (keep :evidence (vals accounted)))) ;; An ADVISORY branch (a reviewer or supervisor role loop) delivers a ;; VERDICT through done, not shippable work: it quotes the run's own ;; figures ("19 tests, 7 failed") and, on a red tree, describes the @@ -491,17 +503,62 @@ (:conn ctx) (:run-id ctx) (:id branch))) evidence (concat own elsewhere) problem (:problem branch) - uncovered (uncovered-tokens answer evidence [problem]) + uncovered (uncovered-tokens claimed evidence [problem]) uncovered-numbers (filter number-token? uncovered) borrowed (when (seq elsewhere) (seq (remove (set uncovered) - (uncovered-tokens answer own [problem])))) - block (ship-gate-block + (uncovered-tokens claimed own [problem])))) + held (when (and (:conn ctx) (:run-id ctx) (:id branch)) + (tasks/held-by (:conn ctx) (:run-id ctx) (:id branch))) + criteria (when-not advisory? + (acceptance/normalize (get-in ctx [:config :run :acceptance]))) + ;; THE CHECKLIST (karamazov-dsfx): what this answer must account + ;; for, item by item. The list items of what the branch was asked — + ;; the run's problem, or for a board piece its task's contract — its + ;; task's tests, what it declared with plan, and for a branch holding + ;; no task the run's acceptance criteria. An advisory branch's + ;; verdict owes none. + ;; A board REVISION branch carries its task on the branch while the + ;; claim stays with the original branch id (board.clj), so held-by + ;; misses it; it still works a task and is not the run's answer (run + ;; 582980ef's T1r1 was asked for another piece's HUD). + works-task? (or (some? held) (some? (:task branch))) + run-level? (not works-task?) + binds? (fn [source] (or (not (contains? (:run-level (checklist/policy)) source)) run-level?)) + items (when-not advisory? + (checklist/items {:acceptance (when (binds? :acceptance) criteria) + :task-tests (:tests held) + :declared (state/checklist branch) + :problem (if held (:contract held) problem) + :whole-problem? works-task?})) + ;; THE EXAM RATCHET (karamazov-fgsb): every test that was there when + ;; the run started and is not in the tree unchanged, and the reasons + ;; the answer gives. An explanation journalled earlier in the run for + ;; the same state of the test counts, so a sibling shipping over a + ;; change it did not make is not asked about it. + explained (exam/explanations (base/arg ctx :changed_tests)) + touched-tests (when (and (not advisory?) (:root ctx) (:git-baseline ctx) + (= :explain (:at-done (exam/policy)))) + (let [root (:root ctx) base (:git-baseline ctx) + now (fn [p] (when-let [abs (files/resolve-under-root root p)] + (let [f (java.io.File. ^String abs)] + (when (.isFile f) (slurp f)))))] + (exam/touched + (for [p (gitdiff/changed-files root base) + :when (exam/test-path? p)] + {:path p :before (gitdiff/file-at root base p) :after (now p)})))) + prior-explained (when (and (seq touched-tests) (:conn ctx) (:run-id ctx)) + (into #{} (comp (mapcat :entries) + (map (juxt :path :test :after-hash))) + (journal/notes (:conn ctx) (:run-id ctx) :tests-explained))) + 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?}) + :advisory? advisory? + :unaccounted-checklist (checklist/unaccounted items accounted) + :unexplained-tests (exam/unexplained touched-tests explained (or prior-explained #{}))}) ;; 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 @@ -518,8 +575,6 @@ ;; siblings' unimplemented work and conclude it had broken something. ;; Its contract names the tests that define ITS delivery, and those are ;; the ones it is judged on (karamazov-ioo.15). - held (when (and (:conn ctx) (:run-id ctx) (:id branch)) - (tasks/held-by (:conn ctx) (:run-id ctx) (:id branch))) ;; THE HELD TASK AND ANY PIECES UNDER IT. A branch assembling a split ;; is judged on its own contract AND on every child's, which is what ;; makes the parent's freedom to adjust the pieces safe: it may reshape @@ -605,8 +660,6 @@ ;; refused, on ship-verify's economy — the answer is going back ;; anyway. system/start! validated the spec, so normalize cannot ;; throw here on a spec that let the system come up. - criteria (when-not advisory? - (acceptance/normalize (get-in ctx [:config :run :acceptance]))) acceptance (when (and (seq criteria) (nil? block)) (acceptance/check criteria @@ -614,7 +667,20 @@ :run-check #(verify/run-verify (:root ctx) % (get-in ctx [:config :run :verify-timeout-ms]))})) - block (or block (some-> acceptance acceptance/refusal))] + block (or block (some-> acceptance acceptance/refusal)) + ;; The accounted checklist rides on the shipped answer: the critic + ;; and the operator read the claims, and a `met` with nothing behind + ;; it is visible where the answer is judged. + answer (if (seq items) (str answer (checklist/render items accounted)) answer) + reasons (exam/explained-record touched-tests explained prior-explained) + answer (if (seq reasons) (str answer (exam/render touched-tests explained prior-explained)) answer)] + (when (and (nil? block) (seq reasons) (:conn ctx) (:run-id ctx)) + (journal/note! (:conn ctx) (:run-id ctx) :tests-explained + {:branch-id (:id branch) :turn (:turn ctx) :data {:entries reasons}})) + (when (and (seq items) (:conn ctx) (:run-id ctx)) + (journal/note! (:conn ctx) (:run-id ctx) :checklist + {:branch-id (:id branch) :turn (:turn ctx) + :data (assoc (checklist/record items accounted) :shipped? (nil? block))})) ;; Journalled whether the tests RAN or not. A rung that was configured on ;; and then did nothing used to leave no trace at all — the note fired only ;; when there was a result — so a run that shipped unverified looked diff --git a/src/samizdat/capabilities.clj b/src/samizdat/capabilities.clj index 43c4fb3..c6bb575 100644 --- a/src/samizdat/capabilities.clj +++ b/src/samizdat/capabilities.clj @@ -28,6 +28,9 @@ samizdat.core requires this; manual-test holds it to the manual." (:require [mycelium.patch] [samizdat.agent.acceptance] + [samizdat.agent.checklist] + [samizdat.agent.exam] + [samizdat.agent.gitdiff] [samizdat.agent.compaction] [samizdat.agent.files] [samizdat.agent.gates] diff --git a/test/samizdat/acceptance_test.clj b/test/samizdat/acceptance_test.clj index a74dc63..fa80a0e 100644 --- a/test/samizdat/acceptance_test.clj +++ b/test/samizdat/acceptance_test.clj @@ -187,7 +187,14 @@ :tool-name "done" :turn 3 :conn c :run-id rid :root "/tmp" :git-baseline "HEAD" :config {:run cfg} - :args {:answer "faded the horizon so the ground dissolves into sky"}})) + :args {:answer "faded the horizon so the ground dissolves into sky" + ;; The criteria are checklist items too + ;; (karamazov-dsfx); this test is about + ;; the checks, so the answer owns up to + ;; each. + :checklist {"a1" {"status" "met" "evidence" "the suite"} + "a2" {"status" "met" "evidence" "the draw test"} + "a3" {"status" "met" "evidence" "the fade shows"}}}})) spec [{:name "suite green" :check "jolt -M:test"} {:name "far trees stand on ground" :check "jolt -M:test :only flight.draw-test"} {:name "says what it saw" :judge "Does the answer say what the screenshot showed?"}]] diff --git a/test/samizdat/agent_test.clj b/test/samizdat/agent_test.clj index 9288caa..9d0d5a6 100644 --- a/test/samizdat/agent_test.clj +++ b/test/samizdat/agent_test.clj @@ -2119,8 +2119,8 @@ ;; predicate/message closures fired on the computed evidence. Adding a rung ;; is a data edit; the evidence computation stays in src. (let [rungs (gates/threshold :ship-gates)] - (is (= 5 (count rungs))) - (is (= [:answer-exists :figure-coverage :engages-problem :asks-the-reader :completeness] + (is (= 7 (count rungs))) + (is (= [:answer-exists :checklist :exam-ratchet :figure-coverage :engages-problem :asks-the-reader :completeness] (mapv :name rungs)))) ;; Asserts the SKELETON, not the sentence: two live runs did the work, ;; passed their tests, closed their task, then spent every remaining turn diff --git a/test/samizdat/board_bt_test.clj b/test/samizdat/board_bt_test.clj index 9326f14..e60a935 100644 --- a/test/samizdat/board_bt_test.clj +++ b/test/samizdat/board_bt_test.clj @@ -24,6 +24,7 @@ reverse-order precondition table is exactly the policy its docstring states." (:require [clojure.string :as str] + [samizdat.fake-done :as fake-done] [clojure.test :refer [deftest testing is]] [mycelium.cell :as cell] [mycelium.core :as myc] @@ -40,7 +41,7 @@ (let [content (str/join " " (map :content messages)) prob (str/trim (or (second (re-find #"## Problem\s+(.+)" content)) "task"))] {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"handled " - prob "\"}}\n```") + prob "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"})) (defn- run-board-bt diff --git a/test/samizdat/board_test.clj b/test/samizdat/board_test.clj index b67bb35..da781f8 100644 --- a/test/samizdat/board_test.clj +++ b/test/samizdat/board_test.clj @@ -13,6 +13,7 @@ owned tasks, an owner splits its task when it is really several, and nothing closes until a critic has read what it changed." (:require [clojure.string :as str] + [samizdat.fake-done :as fake-done] [clojure.test :refer [deftest is testing]] [samizdat.agent.gates :as gates] [samizdat.agent.gitdiff :as gitdiff] @@ -34,7 +35,7 @@ (let [content (str/join " " (map :content messages)) prob (str/trim (or (second (re-find #"## Problem\s+(.+)" content)) "task"))] {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"handled " - prob "\"}}\n```") + prob "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"})) (defn- judge-call? diff --git a/test/samizdat/checklist_test.clj b/test/samizdat/checklist_test.clj new file mode 100644 index 0000000..27f71a1 --- /dev/null +++ b/test/samizdat/checklist_test.clj @@ -0,0 +1,262 @@ +;; samizdat - a self-hosting agentic harness +;; Copyright (C) 2026 Dmitri Sotnikov +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +(ns samizdat.checklist-test + "The ship checklist (karamazov-dsfx). A requirement could ship by being + left out of the answer: the lexical rungs catch a confession, not a + silence. The checklist is data that exists before the work — the + operator's acceptance criteria, the held task's tests, what the branch + declared with `plan`, the problem's own list items — and `done` must + account for every item by id. Omission becomes a missing key." + (:require [clojure.string :as str] + [clojure.test :refer [deftest is testing]] + [samizdat.agent.checklist :as checklist] + [samizdat.agent.gitdiff :as gitdiff] + [samizdat.agent.state :as state] + [samizdat.agent.tools :as tools] + [samizdat.agent.verify :as verify] + [samizdat.store.db :as db] + [samizdat.store.journal :as journal] + [samizdat.store.runs :as runs] + [samizdat.store.tasks :as tasks])) + +(def ^:private problem + "Make the world stop visibly ending at the edge of the terrain. + +- distant ground and trees fade toward the sky colour +- no tree is drawn past the ground it stands on +1. run the game and say what the screenshot showed + +``` +- not a requirement, a line inside a code block +```") + +(deftest the-problem's-list-items-are-its-requirements + (is (= ["distant ground and trees fade toward the sky colour" + "no tree is drawn past the ground it stands on" + "run the game and say what the screenshot showed"] + (checklist/problem-items problem))) + (is (= [] (checklist/problem-items "Fix the off-by-one in paging.")) "prose alone has no items")) + +(deftest items-take-an-id-per-source-in-a-stable-order + (let [its (checklist/items {:acceptance [{:name "suite green" :kind :check :text "jolt -M:test"} + {:name "says what it saw" :kind :judge :text "Does it say?"}] + :task-tests "the page shows one item left per user" + :declared ["blend toward sky" "cull at the terrain edge"] + :problem problem})] + (is (= ["a1" "a2" "t1" "c1" "c2" "p1" "p2" "p3"] (mapv :id its))) + (is (= "suite green" (:text (first its)))) + (is (= "Does it say?" (:text (second its))) "a judge criterion is its question") + (is (= #{:acceptance :task :declared :problem} (set (map :source its)))))) + +(deftest a-test-path-is-not-a-checklist-item + ;; A task whose :tests is a file is judged by running it (verify), not by + ;; the answer saying so. + (is (empty? (checklist/items {:task-tests "test/app/core_test.clj"})))) + +(deftest the-answer's-entries-are-read-leniently-and-judged-strictly + (testing "a vector of entries, or a map by id" + (is (= {"a1" {:status :met :evidence "ran it"}} + (checklist/entries [{"item" "a1" "status" "met" "evidence" "ran it"}]))) + (is (= {"c1" {:status :not-met :evidence "no display"}} + (checklist/entries {"C1" {"status" "not met" "evidence" "no display"}}))) + (is (= {"p2" {:status :n-a :evidence "menus are out of scope"}} + (checklist/entries [{:id "p2" :status "N/A" :note "menus are out of scope"}])))) + (testing "a JSON string of the same" + (is (= :met (get-in (checklist/entries "[{\"item\":\"a1\",\"status\":\"met\",\"evidence\":\"x\"}]") + ["a1" :status])))) + (testing "garbage is no entries, not an error" + (is (= {} (checklist/entries "all done"))) + (is (= {} (checklist/entries nil))))) + +(deftest an-item-is-accounted-for-only-with-a-known-status-and-a-reason + (let [its (checklist/items {:declared ["one" "two" "three" "four"]}) + es (checklist/entries [{"item" "c1" "status" "met" "evidence" "test x passes"} + {"item" "c2" "status" "probably" "evidence" "yes"} + {"item" "c3" "status" "not_met" "evidence" ""}])] + (is (= ["c2" "c3" "c4"] (mapv :id (checklist/unaccounted its es))) + "an unknown status, a blank reason and a missing entry all count as silence"))) + +(deftest the-accounted-checklist-rides-on-the-answer + (let [its (checklist/items {:declared ["blend toward sky" "cull at the edge"]}) + es (checklist/entries [{"item" "c1" "status" "met" "evidence" "fade-test passes"} + {"item" "c2" "status" "not_met" "evidence" "no display here"}]) + out (checklist/render its es)] + (is (str/includes? out "blend toward sky")) + (is (str/includes? out "fade-test passes")) + (is (str/includes? out "no display here")) + (is (re-find #"(?i)not met" out)))) + +;; A board piece's contract is usually one line: the RFC's work item. With +;; no list items in it, the contract itself is the requirement (run +;; 582980ef: three pieces shipped owing nothing). +(deftest a-contract-without-list-items-is-one-item + (is (= ["Combo state machine: add ring-value. Tests: chain, cap, reset."] + (mapv :text (checklist/items {:problem "Combo state machine: add ring-value. Tests: chain, cap, reset.\n\nNotes after." + :whole-problem? true})))) + (is (= [] (checklist/items {:problem "Fix the pager."})) "a run's prose problem is not")) + +;; --- done ----------------------------------------------------------------------- + +(defn- ship + ([args] (ship args {})) + ([args {:keys [branch cfg conn run-id]}] + (with-redefs [gitdiff/changed-files (fn [_ _] ["src/x.clj" "test/x_test.clj"]) + verify/run-verify (fn [_ _ _] {:green? true :output "Ran 3 tests. 0 failures, 0 errors"})] + (tools/run-tool {:branch (or branch (state/new-branch {:id "B1" :problem problem})) + :tool-name "done" :turn 3 :root "/tmp" :git-baseline "HEAD" + :conn conn :run-id run-id + :config {:run (merge {:verify-cmd "jolt -M:test"} cfg)} + :args args})))) + +(def ^:private silent-answer + "Distant ground and trees now blend toward the sky colour by distance, and + trees are only drawn inside the terrain. The suite is green.") + +(deftest done-refuses-an-answer-that-is-silent-on-an-item + ;; dsfx's case D: the answer that simply never mentions the requirement. + (let [r (ship {:answer silent-answer})] + (is (not (:done? r))) + (is (str/includes? (:result r) "p3") (:result r)) + (is (str/includes? (:result r) "run the game and say what the screenshot showed") + "the refusal names the item in its own words") + (is (str/includes? (:result r) "checklist") "and says how to account for it"))) + +(deftest an-honest-not-met-ships + ;; ylte.1: an honest limit is a result. What is refused is silence. + (let [r (ship {:answer silent-answer + :checklist [{"item" "p1" "status" "met" "evidence" "fade test"} + {"item" "p2" "status" "met" "evidence" "cull test"} + {"item" "p3" "status" "not_met" "evidence" "no window server on this host"}]})] + (is (:done? r) (:result r)) + (is (str/includes? (:answer r) "no window server on this host") + "the shipped answer carries the checklist, so the critic reads the claims"))) + +(deftest acceptance-criteria-are-items-for-a-run-level-answer + (let [spec [{:name "suite green" :check "jolt -M:test"} + {:name "says what it saw" :judge "Does the answer say what the screenshot showed?"}] + branch (state/new-branch {:id "B1" :problem "fade distant ground and trees toward the sky colour"})] + (let [r (ship {:answer silent-answer} {:branch branch :cfg {:acceptance spec}})] + (is (not (:done? r))) + (is (str/includes? (:result r) "a2")) + (is (str/includes? (:result r) "Does the answer say what the screenshot showed?"))) + (let [r (ship {:answer silent-answer + :checklist {"a1" {"status" "met" "evidence" "jolt -M:test green"} + "a2" {"status" "met" "evidence" "the screenshot shows the fade"}}} + {:branch branch :cfg {:acceptance spec}})] + (is (:done? r) (:result r))))) + +(deftest a-task-branch-answers-for-its-task-not-the-run + ;; A board piece is judged on its own contract; the run's criteria and the + ;; problem's list are the run-level answer's to account for. + (let [c (db/open! ":memory:") + rid (runs/start-run! c {:problem problem})] + (try + (let [t (tasks/create! c {:title "register the test ns" :run-id rid + :contract "Register the namespace:\n- in the :require vector\n- in the run-tests list" + :tests "the runner lists flight.horizon-test in both places\n\nWrite the test first."}) + _ (tasks/claim! c t rid "B1") + r (ship {:answer "registered it in the require vector and the run list"} + {:conn c :run-id rid :cfg {:acceptance [{:name "suite green" :check "jolt -M:test"}]}})] + (is (not (:done? r))) + (is (str/includes? (:result r) "t1")) + (is (str/includes? (:result r) "in the run-tests list") "its task's contract is its problem") + (is (not (str/includes? (:result r) "Write the test first")) "the tests' first paragraph only") + (is (not (str/includes? (:result r) "distant ground")) "the run's problem is not this branch's") + (is (not (str/includes? (:result r) "a1")) "nor are the run's criteria")) + (finally (db/close c))))) + +(deftest a-revision-branch-answers-for-its-task-not-the-run + ;; Run 582980ef: a board revision branch (T1r1) carries its task on the + ;; branch while the claim stays with the original branch id, so it was + ;; read as the run's answer and owed all six acceptance criteria, + ;; including another piece's HUD. + (let [c (db/open! ":memory:") + rid (runs/start-run! c {:problem problem})] + (try + (let [t (tasks/create! c {:title "visual check" :run-id rid :contract "Run the game and describe the screenshot."}) + _ (tasks/claim! c t rid "T1") + b (assoc (state/new-branch {:id "T1r1" :problem "Address the review:\n- [medium] the claim about visual_test is not in the diff"}) + :task {:id t :title "visual check"}) + r (ship {:answer "addressed the review of the visual check"} + {:branch b :conn c :run-id rid :cfg {:acceptance [{:name "suite green" :check "jolt -M:test"}]}})] + (is (not (:done? r))) + (is (str/includes? (:result r) "the claim about visual_test is not in the diff") "its findings are its list") + (is (not (str/includes? (:result r) "suite green")) "the run's criteria are not its to answer")) + (finally (db/close c))))) + +(deftest what-plan-declared-is-owed-and-a-re-plan-cannot-drop-it + (let [b (-> (state/new-branch {:id "B1" :problem "fix the pager"}) + (state/declare-checklist ["pages are 1-based" "the last page is not empty"]) + (state/declare-checklist ["pages are 1-based" "a page size of 0 is refused"]))] + (is (= ["pages are 1-based" "the last page is not empty" "a page size of 0 is refused"] + (state/checklist b))) + (let [r (ship {:answer "fixed the pager"} {:branch b})] + (is (not (:done? r))) + (is (str/includes? (:result r) "the last page is not empty"))))) + +(deftest a-re-plan-that-labels-its-items-restates-them + ;; Run 582980ef's T1r1 wrote "c1: ...".."c4: ..." and reworded them on + ;; each re-plan; the union grew to c8 while the model kept answering + ;; c1..c4, and done was refused three times for items it believed were + ;; the ones it had answered. + (let [b (-> (state/new-branch {:id "B1" :problem "p"}) + (state/declare-checklist ["c1: the fresh shot test passes" "c2: decode-rgb under cc 10"]) + (state/declare-checklist ["c1: shot test present and passing" "c2: decode-rgb split" + "c3: fixture relationship documented"]))] + (is (= ["the fresh shot test passes" "decode-rgb under cc 10" "fixture relationship documented"] + (state/checklist b)) + "a labelled item restates the one it names; a new label adds"))) + +(deftest the-plan-tool-takes-a-checklist + (let [r (tools/run-tool {:branch (state/new-branch {:id "B1" :problem "fix the pager"}) + :tool-name "plan" :turn 1 + :args {:files ["src/pager.clj"] :checklist ["pages are 1-based"]}})] + (is (= ["pages are 1-based"] (state/checklist (:branch r))))) + (testing "items given as {label text} maps (run 6e3eda8a) read as labelled items" + (let [r (tools/run-tool {:branch (state/new-branch {:id "B1" :problem "fix the pager"}) + :tool-name "plan" :turn 1 + :args {:files ["src/pager.clj"] + :checklist [{"c1" "pages are 1-based"} {:text "a page size of 0 is refused"}]}})] + (is (= ["pages are 1-based" "a page size of 0 is refused"] (state/checklist (:branch r))))))) + +(deftest an-entry-may-name-its-item-by-its-exact-text + (let [its (checklist/items {:declared ["pages are 1-based" "a page size of 0 is refused"]}) + es (checklist/entries [{"item" "Pages are 1-based." "status" "met" "evidence" "pager-test"} + {"item" "a page size of zero is refused" "status" "met" "evidence" "x"}])] + (is (= ["c2"] (mapv :id (checklist/unaccounted its es))) + "the exact text (case and a closing full stop aside) is the item; a paraphrase is not"))) + +(deftest an-advisory-branch-owes-no-checklist + (let [r (ship {:answer "PASS: the round implements the feature"} + {:branch (assoc (state/new-branch {:id "S0" :problem problem}) :advisory? true)})] + (is (:done? r) (:result r)))) + +(deftest the-checklist-is-journalled-on-a-ship + (let [c (db/open! ":memory:") + rid (runs/start-run! c {:problem problem})] + (try + (ship {:answer silent-answer + :checklist [{"item" "p1" "status" "met" "evidence" "fade test"} + {"item" "p2" "status" "met" "evidence" "cull test"} + {"item" "p3" "status" "n/a" "evidence" "the operator runs it"}]} + {:conn c :run-id rid}) + (let [[note] (journal/notes c rid :checklist)] + (is (= ["p1" "p2" "p3"] (mapv :id (:items note)))) + (is (= "n-a" (:status (some #(when (= "p3" (:id %)) %) (:entries note)))))) + (finally (db/close c))))) diff --git a/test/samizdat/exam_ratchet_test.clj b/test/samizdat/exam_ratchet_test.clj new file mode 100644 index 0000000..2675b2e --- /dev/null +++ b/test/samizdat/exam_ratchet_test.clj @@ -0,0 +1,183 @@ +;; samizdat - a self-hosting agentic harness +;; Copyright (C) 2026 Dmitri Sotnikov +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +(ns samizdat.exam-ratchet-test + "The exam ratchet at `done` (karamazov-fgsb, owner's decision 2026-09-29): + a run may change or delete a test that existed when it started, and must + say why. Every pre-existing test the branch's tree no longer holds + unchanged is named at ship time, and an unexplained one refuses `done`. + + The fixtures are the real edits the bead measured and the 2026-09-29 + corpus of 50 edit_file hunks: a per-assertion-line diff missed a deleted + table row, a changed `let` input and a continuation line, which comparing + whole test forms catches." + (:require [clojure.java.io :as io] + [clojure.string :as str] + [clojure.test :refer [deftest is testing]] + [samizdat.agent.exam :as exam] + [samizdat.agent.gitdiff :as gitdiff] + [samizdat.agent.state :as state] + [samizdat.agent.tools :as tools] + [samizdat.agent.verify :as verify] + [samizdat.store.db :as db] + [samizdat.store.journal :as journal] + [samizdat.store.runs :as runs])) + +(def ^:private db-test-before + "(ns app.db-test (:require [clojure.test :refer [deftest is testing]] [app.db :as db])) + +(deftest active-count + (testing \"active-count counts done=0 only\" + (is (= 1 (db/active-count *conn*))))) + +(deftest blank-titles + (testing \"add-todo! with a blank title returns nil and stores nothing\" + (is (nil? (db/add-todo! *conn* \" \"))) + (is (= 0 (count (db/list-todos *conn*)))))) +") + +(defn- touched [files] + (mapv #(select-keys % [:path :test :kind]) (exam/touched files))) + +(deftest a-deleted-deftest-is-touched + ;; a3ba69bb t28: blank-titles went as collateral in an edit repairing + ;; another test. + (let [after (str/replace db-test-before #"(?s)\(deftest blank-titles.*" "")] + (is (= [{:path "test/app/db_test.clj" :test "blank-titles" :kind :deleted}] + (touched [{:path "test/app/db_test.clj" :before db-test-before :after after}]))))) + +(deftest a-changed-input-or-table-row-is-touched + (testing "a changed let input (8710067f t25)" + (is (= [{:path "test/e_test.clj" :test "grunt-hits" :kind :changed}] + (touched [{:path "test/e_test.clj" + :before "(deftest grunt-hits (let [e {:x 1.0}] (is (hit? e))))" + :after "(deftest grunt-hits (let [e {:x 0.9}] (is (hit? e))))"}])))) + (testing "a row gone from a data table (4e785664 t22)" + (is (= [{:path "test/d_test.clj" :test "cases" :kind :changed}] + (touched [{:path "test/d_test.clj" + :before "(def cases [[{:a 1} nil] [nil nil]])" + :after "(def cases [[{:a 1} nil]])"}]))))) + +(deftest what-keeps-a-test's-meaning-is-not-touched + (testing "whitespace and comments" + (is (empty? (touched [{:path "test/t_test.clj" + :before "(deftest t\n (is (= 1 (f))) ; one\n)" + :after "(deftest t (is (= 1 (f))))"}])))) + (testing "a fn literal reads with fresh gensyms each time and is still the same test" + (is (empty? (touched [{:path "test/t_test.clj" + :before "(deftest t (is (every? #(pos? %) (xs))))" + :after "(deftest t (is (every? #(pos? %) (xs))))"}])))) + (testing "a new test, and a helper that changed" + (is (empty? (touched [{:path "test/t_test.clj" + :before "(defn- helper [] 1)\n(deftest t (is (= 1 (helper))))" + :after "(defn- helper [] (inc 0))\n(deftest t (is (= 1 (helper))))\n(deftest u (is true))"}]))))) + +(deftest a-test-moved-to-another-file-is-not-touched + ;; e1b765e7: the largest false alarm of the first detector was a refactor. + (let [t "(deftest seam-flies (is (= 3 (count (fly)))))"] + (is (empty? (touched [{:path "test/a_test.clj" :before (str "(ns a)\n" t) :after "(ns a)"} + {:path "test/b_test.clj" :before nil :after (str "(ns b)\n" t)}]))))) + +(deftest a-file-that-does-not-read-falls-back-to-its-assertion-lines + ;; 170f4ec9 (Python): four contract assertions replaced by a bare call. + (is (= [{:path "test_calc.py" :test nil :kind :changed}] + (touched [{:path "test_calc.py" + :before "def test_mul():\n assert mul(2, 3) == 6\n assert mul(0, 5) == 0\n" + :after "def test_mul():\n mul(1, 1)\n"}]))) + (is (empty? (touched [{:path "test_calc.py" + :before "def test_mul():\n assert mul(2, 3) == 6\n" + :after "def test_mul():\n assert mul(2, 3) == 6\n assert mul(0, 5) == 0\n"}])) + "an added assertion changes nothing that was there")) + +(deftest an-explanation-names-the-test-and-gives-a-reason + (let [ts [{:path "test/app/db_test.clj" :test "blank-titles" :kind :deleted} + {:path "test_calc.py" :test nil :kind :changed}]] + (is (= ts (exam/unexplained ts {}))) + (is (= [(second ts)] + (exam/unexplained ts (exam/explanations [{"test" "blank-titles" "reason" "moved to validation_test"}])))) + (is (= [(first ts)] + (exam/unexplained ts (exam/explanations {"test_calc.py" "the contract changed: mul is gone"}))) + "a file stands for the assertions of a file that does not read") + (is (= ts (exam/unexplained ts (exam/explanations [{"test" "blank-titles" "reason" " "}]))) + "a blank reason explains nothing") + ;; Run 582980ef: the model named the test as ns/name and as name (file). + (is (= [(second ts)] + (exam/unexplained ts (exam/explanations [{"test" "app.db-test/blank-titles" "reason" "moved"}])))) + (is (= [(second ts)] + (exam/unexplained ts (exam/explanations [{"test" "Blank-Titles (test/app/db_test.clj)" "reason" "moved"}])))) + (is (= ts (exam/unexplained ts (exam/explanations [{"test" "blank-titles-2" "reason" "moved"}]))) + "a different name is not the test"))) + +;; --- done ----------------------------------------------------------------------- + +(defn- tmp-root [] + (let [d (io/file (System/getProperty "java.io.tmpdir") (str "exam-" (System/nanoTime)))] + (.mkdirs (io/file d "test" "app")) + (.getPath d))) + +(defn- ship [root args {:keys [conn run-id branch]}] + (with-redefs [gitdiff/changed-files (fn [_ _] ["src/app/db.clj" "test/app/db_test.clj"]) + gitdiff/file-at (fn [_ _ path] (when (= path "test/app/db_test.clj") db-test-before)) + verify/run-verify (fn [_ _ _] {:green? true :output "Ran 2 tests. 0 failures, 0 errors"})] + (tools/run-tool {:branch (or branch (state/new-branch {:id "B1" :problem "make blank titles an error"})) + :tool-name "done" :turn 3 :root root :git-baseline "HEAD" + :conn conn :run-id run-id + :config {:run {:verify-cmd "jolt -M:test"}} + :args args}))) + +(deftest done-refuses-an-unexplained-deleted-test + (let [root (tmp-root)] + (spit (io/file root "test/app/db_test.clj") (str/replace db-test-before #"(?s)\(deftest blank-titles.*" "")) + (let [r (ship root {:answer "blank titles are now an error; the suite is green"} {})] + (is (not (:done? r))) + (is (str/includes? (:result r) "blank-titles") (:result r)) + (is (str/includes? (:result r) "changed_tests") "and says how to explain it")) + (let [r (ship root {:answer "blank titles are now an error; the suite is green" + :changed_tests [{"test" "blank-titles" "reason" "blank titles now throw; pinned in blank-title-throws"}]} + {})] + (is (:done? r) (:result r)) + (is (str/includes? (:answer r) "blank titles now throw") "the reason rides on the answer")))) + +(deftest a-tree-that-kept-its-tests-owes-nothing + (let [root (tmp-root)] + (spit (io/file root "test/app/db_test.clj") + (str db-test-before "\n(deftest blank-title-throws (is (thrown? Exception (db/add-todo! *conn* \"\"))))\n")) + (is (:done? (ship root {:answer "blank titles are now an error; the suite is green"} {}))))) + +(deftest an-explanation-from-earlier-in-the-run-still-counts + ;; A board run: the branch that changed the test explained it when it + ;; shipped; a sibling shipping later over the same tree is not asked again. + (let [root (tmp-root) + c (db/open! ":memory:") + rid (runs/start-run! c {:problem "make blank titles an error"})] + (try + (spit (io/file root "test/app/db_test.clj") (str/replace db-test-before #"(?s)\(deftest blank-titles.*" "")) + (is (:done? (ship root {:answer "blank titles are now an error; the suite is green" + :changed_tests [{"test" "blank-titles" "reason" "replaced by blank-title-throws"}]} + {:conn c :run-id rid}))) + (is (seq (journal/notes c rid :tests-explained))) + (is (:done? (ship root {:answer "blank titles are now an error; the suite is green"} + {:conn c :run-id rid :branch (state/new-branch {:id "B2" :problem "make blank titles an error"})})) + "the sibling ships over the explained change") + (finally (db/close c))))) + +(deftest an-advisory-branch-owes-no-explanation + (let [root (tmp-root)] + (spit (io/file root "test/app/db_test.clj") "") + (is (:done? (ship root {:answer "REVISE: blank-titles was deleted without a word"} + {:branch (assoc (state/new-branch {:id "S0" :problem "review"}) :advisory? true)}))))) diff --git a/test/samizdat/fake_done.clj b/test/samizdat/fake_done.clj new file mode 100644 index 0000000..25f6fbb --- /dev/null +++ b/test/samizdat/fake_done.clj @@ -0,0 +1,15 @@ +;; samizdat - a self-hosting agentic harness +;; SPDX-License-Identifier: GPL-3.0-or-later + +(ns samizdat.fake-done + "What a scripted model sends with `done` so the ship checklist + (karamazov-dsfx) does not refuse it: an entry for every id a test's branch + can owe — its task's tests (t1) and the list items of what it was asked + (p1..). An entry for an item that is not owed is ignored.") + +(def checklist-json + "The checklist argument as JSON, for a fenced tool call." + (str "{" + (apply str (interpose "," (map #(str "\"" % "\":{\"status\":\"met\",\"evidence\":\"handled\"}") + (cons "t1" (map (partial str "p") (range 1 10)))))) + "}")) diff --git a/test/samizdat/feature_test.clj b/test/samizdat/feature_test.clj index 3549a95..6c47446 100644 --- a/test/samizdat/feature_test.clj +++ b/test/samizdat/feature_test.clj @@ -9,6 +9,7 @@ ship, the reviewer's revise bounce, and the supervisor's directives landing at the stage that applies them (RFC-012)." (:require [clojure.string :as str] + [samizdat.fake-done :as fake-done] [clojure.test :refer [deftest testing is use-fixtures]] [samizdat.agent.files :as files] [samizdat.agent.gitdiff :as gitdiff] @@ -55,7 +56,7 @@ (defn- done-call [answer] {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"" - answer "\"}}\n```") + answer "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"}) (defn- review-answer diff --git a/test/samizdat/gitdiff_test.clj b/test/samizdat/gitdiff_test.clj index 7286827..ef41909 100644 --- a/test/samizdat/gitdiff_test.clj +++ b/test/samizdat/gitdiff_test.clj @@ -133,3 +133,24 @@ (is (nil? (:branch s)) "no branch to name") (is (= "one" (:last-commit s)))) (finally (sh dir (str "rm -rf " dir))))))) + +(deftest a-project-nested-in-a-larger-repository-sees-its-own-paths + ;; `git diff --name-only` prints paths from the REPOSITORY top, while the + ;; untracked listing and every reader of these paths work from the project + ;; root. A project in a subdirectory of a repo read its tracked edits as + ;; paths that did not exist under it. + (when (proc/available? "git") + (let [dir (str (System/getProperty "java.io.tmpdir") "/gd-nested-" (System/currentTimeMillis)) + proj (str dir "/games/flight")] + (try + (proc/run {:timeout-ms 15000} "sh" "-c" (str "mkdir -p " proj "/test")) + (sh dir "git init -q && git config user.email t@t.co && git config user.name t") + (sh proj "echo '(deftest a (is true))' > test/a_test.clj && echo x > ../../other.txt && git add -A && git commit -qm init") + (let [base (gd/baseline proj)] + (sh proj "echo '(deftest a (is false))' > test/a_test.clj && echo y > ../../other.txt") + (is (= ["test/a_test.clj"] (gd/changed-files proj base)) + "paths from the project root, and nothing outside it") + (is (= "(deftest a (is true))\n" (gd/file-at proj base "test/a_test.clj")) + "and file-at reads the same path as the run found it") + (is (nil? (gd/file-at proj base "test/missing_test.clj")))) + (finally (sh dir (str "rm -rf " dir))))))) diff --git a/test/samizdat/team_test.clj b/test/samizdat/team_test.clj index 12d737d..a6ab354 100644 --- a/test/samizdat/team_test.clj +++ b/test/samizdat/team_test.clj @@ -5,6 +5,7 @@ "Multi-agent fan-out: the team manifest runs a worker per sub-task in parallel and joins their answers." (:require [clojure.string :as str] + [samizdat.fake-done :as fake-done] [clojure.test :refer [deftest testing is]] [samizdat.llm.client :as llm] [samizdat.store.db :as db] @@ -17,7 +18,7 @@ (let [content (str/join " " (map :content messages)) prob (or (second (re-find #"## Problem\s+(\w+)" content)) "task")] {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"handled " - prob "\"}}\n```") + prob "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"})) (deftest team-fans-out-a-worker-per-subtask-and-joins @@ -78,7 +79,7 @@ {:content "- part one\n- part two" :finish-reason "stop"} (let [prob (str/trim (or (second (re-find #"## Problem\s+(.+)" content)) "task"))] {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"handled " - prob "\"}}\n```") + prob "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"})))) (deftest team-plans-its-own-split-when-no-subtasks-are-given @@ -125,7 +126,7 @@ (if (contains? @seen prob) ;; second sighting — the retry — succeeds {:content (str "```tool-call\n{\"name\":\"done\",\"args\":{\"answer\":\"handled " - prob "\"}}\n```") + prob "\",\"checklist\":" fake-done/checklist-json "}}\n```") :finish-reason "stop"} ;; first sighting: give up, so the supervisor must re-task it. ;; diff --git a/test/samizdat/test_runner.clj b/test/samizdat/test_runner.clj index 1421c62..726402c 100644 --- a/test/samizdat/test_runner.clj +++ b/test/samizdat/test_runner.clj @@ -73,6 +73,7 @@ [samizdat.compaction-test] [samizdat.collab-test] [samizdat.acceptance-test] + [samizdat.checklist-test] [samizdat.select-test] [samizdat.stats-test] [samizdat.session-test] @@ -139,6 +140,7 @@ [samizdat.events-test] [samizdat.escapes-test] [samizdat.exam-test] + [samizdat.exam-ratchet-test] [samizdat.cell-schema-test] [samizdat.mutation-test] [samizdat.ratelimit-test] @@ -288,6 +290,7 @@ samizdat.compaction-test samizdat.collab-test samizdat.acceptance-test + samizdat.checklist-test samizdat.select-test samizdat.stats-test samizdat.session-test @@ -354,6 +357,7 @@ samizdat.events-test samizdat.escapes-test samizdat.exam-test + samizdat.exam-ratchet-test samizdat.cell-schema-test samizdat.mutation-test samizdat.ratelimit-test