Files
rose-ash/lib/agentic/tests/branch.sx
giles 88c4963fd0 agentic-sx Phase 2: branch — one branch = one agent (TDD)
space handle (repo + relations Datalog db); spawn! = branch-from-briefing
with a genesis spawn commit at the fork point; commit! verb snapshots a full
worktree VALUE into a typed agent-commit and CAS-advances the branch (no
shared index — multi-agent safe). Topology: fork-point via merge-base,
agents from refs, typed edges sub-agent-of/reviews/merges. Session merges
always record a two-parent session-merge commit (no-ff); conflicts commit
nothing and conclude via merge-resolve!. 53/53 (118/118 total).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-03 12:53:58 +00:00

333 lines
9.2 KiB
Plaintext

; Phase 2 — branch: one branch = one agent. Fixture story: root-1 coordinates
; a refactor; lexer-1 + parser-1 spawn from its plan commit (lexer-1a nested
; under lexer-1); their sessions merge back (ff-shaped and true 3-way), then
; risky-1 collides with root-1 on plan.md and the conflict is resolved via
; merge-resolve!. Edges: sub-agent-of / reviews / merges.
(define agb-db (persist/mem-backend))
(define agb-sp (agentic/space agb-db "agentic-branch-test"))
(define agb-repo (agentic/space-repo agb-sp))
(define
agb-root-briefing
(agentic/briefing "coordinate refactor" "split parser module" {}))
(define agb-root (agentic/spawn! agb-sp "root-1" agb-root-briefing))
(agentic-test "spawn returns the agent" (get agb-root :agent) "root-1")
(agentic-test
"spawn creates the agent branch"
(contains? (git/branches agb-repo) "agents/root-1")
true)
(agentic-test
"head is the genesis"
(= (agentic/head agb-sp "root-1") (get agb-root :genesis))
true)
(agentic-test
"genesis is a spawn commit"
(agentic/commit-kind (git/read agb-repo (get agb-root :genesis)))
"spawn")
(agentic-test
"genesis records the briefing"
(agentic/commit-briefing (git/read agb-repo (get agb-root :genesis)))
(get agb-root :briefing))
(agentic-test
"briefing-of reads back the briefing"
(agentic/briefing-title (agentic/briefing-of agb-sp "root-1"))
"coordinate refactor")
(agentic-test
"root genesis has no parents"
(= (git/parents agb-repo (get agb-root :genesis)) (list))
true)
(agentic-test
"spawn is create-only"
(has-key? (agentic/spawn! agb-sp "root-1" agb-root-briefing) :conflict)
true)
(agentic-test
"agents lists the branch set"
(= (agentic/agents agb-sp) (list "root-1"))
true)
; ---- the commit verb ----
(define
agb-c1
(agentic/commit!
agb-sp
"root-1"
"decision"
(assoc {} "plan.md" "split into lexer+parser\n")
{:message "plan recorded"}))
(agentic-test "commit! returns a cid" (starts-with? agb-c1 "sx1:") true)
(agentic-test
"commit! advances the head"
(= (agentic/head agb-sp "root-1") agb-c1)
true)
(agentic-test
"commit! records the kind"
(agentic/commit-kind (git/read agb-repo agb-c1))
"decision")
(agentic-test
"briefing propagates to every commit"
(agentic/commit-briefing (git/read agb-repo agb-c1))
(get agb-root :briefing))
(agentic-test
"commit! snapshots the worktree"
(get (git/commit-files agb-repo agb-c1) "plan.md")
"split into lexer+parser\n")
(agentic-test
"unknown kind is rejected"
(get
(agentic/commit! agb-sp "root-1" "frobnicate" {} {})
:error)
"unknown-kind")
(agentic-test
"commit to unknown agent fails"
(get
(agentic/commit! agb-sp "ghost" "finding" {} {})
:error)
"no-such-agent")
(agentic-test
"session-log newest first"
(=
(agentic/session-log agb-sp "root-1")
(list agb-c1 (get agb-root :genesis)))
true)
(agentic-test
"genesis found from head"
(= (agentic/genesis agb-sp "root-1") (get agb-root :genesis))
true)
; ---- sub-agents fork at the parent head ----
(define
agb-lex-briefing
(agentic/briefing "extract lexer" "pull tokenizer into lexer.sx" {}))
(define
agb-lex
(agentic/spawn-from! agb-sp "lexer-1" agb-lex-briefing "root-1"))
(define
agb-par-briefing
(agentic/briefing "extract parser" "pull grammar into parser.sx" {}))
(define
agb-par
(agentic/spawn-from! agb-sp "parser-1" agb-par-briefing "root-1"))
(agentic-test
"spawn-from creates the sub branch"
(get agb-lex :agent)
"lexer-1")
(agentic-test
"sub genesis forks at the parent head"
(= (git/parents agb-repo (get agb-lex :genesis)) (list agb-c1))
true)
(agentic-test
"sub genesis inherits the base tree"
(get (git/commit-files agb-repo (get agb-lex :genesis)) "plan.md")
"split into lexer+parser\n")
(agentic-test
"sub-agent edges recorded"
(= (agentic/sub-agents agb-sp "root-1") (list "lexer-1" "parser-1"))
true)
(agentic-test
"parent-agent edge"
(agentic/parent-agent agb-sp "lexer-1")
"root-1")
(agentic-test
"root has no parent agent"
(agentic/parent-agent agb-sp "root-1")
nil)
(agentic-test
"spawn-from unknown parent fails"
(get (agentic/spawn-from! agb-sp "x-1" agb-lex-briefing "ghost") :error)
"no-such-agent")
(agentic-test
"agents lists all branches sorted"
(= (agentic/agents agb-sp) (list "lexer-1" "parser-1" "root-1"))
true)
(define
agb-lex2
(agentic/spawn-from!
agb-sp
"lexer-1a"
(agentic/briefing "lexer unicode" "handle utf8 in the lexer" {})
"lexer-1"))
(agentic-test
"agent-tree is transitive"
(=
(agentic/agent-tree agb-sp "root-1")
(list "lexer-1" "lexer-1a" "parser-1"))
true)
; ---- parallel session work ----
(define
agb-lc1
(agentic/commit!
agb-sp
"lexer-1"
"refactor"
(merge
(git/commit-files agb-repo (get agb-lex :genesis))
(assoc {} "lexer.sx" "(define lexer 1)\n"))
{:message "lexer extracted"}))
(define
agb-pc1
(agentic/commit!
agb-sp
"parser-1"
"refactor"
(merge
(git/commit-files agb-repo (get agb-par :genesis))
(assoc {} "parser.sx" "(define parser 1)\n"))
{:message "parser extracted"}))
(agentic-test
"fork-point of sibling agents"
(= (agentic/fork-point agb-sp "lexer-1" "parser-1") agb-c1)
true)
(agentic-test
"fork-point with itself is its head"
(= (agentic/fork-point agb-sp "lexer-1" "lexer-1") agb-lc1)
true)
(agentic-test
"fork-point with unknown agent"
(agentic/fork-point agb-sp "lexer-1" "ghost")
nil)
; ---- session merge: ff-shaped history still gets a merge commit ----
(define agb-m1 (agentic/merge-session! agb-sp "root-1" "lexer-1" {:message "absorb lexer session"}))
(agentic-test "session merge merges" (get agb-m1 :result) "merged")
(agentic-test
"merge commit has both session parents"
(= (git/parents agb-repo (get agb-m1 :cid)) (list agb-c1 agb-lc1))
true)
(agentic-test
"merge advances the into head"
(= (agentic/head agb-sp "root-1") (get agb-m1 :cid))
true)
(agentic-test
"merge commit is a session-merge"
(agentic/commit-kind (git/read agb-repo (get agb-m1 :cid)))
"session-merge")
(agentic-test
"merge names the merged agent"
(get (git/read agb-repo (get agb-m1 :cid)) :merged-agent)
"lexer-1")
(agentic-test
"merged tree carries the merged session"
(get (git/commit-files agb-repo (get agb-m1 :cid)) "lexer.sx")
"(define lexer 1)\n")
(agentic-test
"merge keeps the into briefing"
(agentic/commit-briefing (git/read agb-repo (get agb-m1 :cid)))
(get agb-root :briefing))
(agentic-test
"merges edge recorded"
(= (agentic/merged-sessions agb-sp "root-1") (list "lexer-1"))
true)
(agentic-test
"merged-into inverse"
(= (agentic/merged-into agb-sp "lexer-1") (list "root-1"))
true)
(agentic-test
"re-merge is up-to-date"
(get (agentic/merge-session! agb-sp "root-1" "lexer-1" {}) :result)
"up-to-date")
; ---- true three-way merge ----
(define agb-m2 (agentic/merge-session! agb-sp "root-1" "parser-1" {:message "absorb parser session"}))
(agentic-test "three-way session merge" (get agb-m2 :result) "merged")
(agentic-test
"three-way tree unions the sessions"
(get (git/commit-files agb-repo (get agb-m2 :cid)) "parser.sx")
"(define parser 1)\n")
(agentic-test
"three-way tree keeps ours side"
(get (git/commit-files agb-repo (get agb-m2 :cid)) "lexer.sx")
"(define lexer 1)\n")
; ---- conflicting sessions ----
(define
agb-risk
(agentic/spawn-from!
agb-sp
"risky-1"
(agentic/briefing "rewrite plan" "contentious plan edit" {})
"root-1"))
(define agb-risk-files (git/commit-files agb-repo (get agb-risk :genesis)))
(define
agb-rc1
(agentic/commit!
agb-sp
"risky-1"
"decision"
(merge agb-risk-files (assoc {} "plan.md" "risky rewrite\n"))
{:message "risky plan"}))
(define
agb-rootc2
(agentic/commit!
agb-sp
"root-1"
"decision"
(merge agb-risk-files (assoc {} "plan.md" "steady as she goes\n"))
{:message "root plan"}))
(define agb-mc (agentic/merge-session! agb-sp "root-1" "risky-1" {:message "risky merge"}))
(agentic-test
"conflicting sessions surface conflicts"
(get agb-mc :result)
"conflicts")
(agentic-test
"conflict paths name the file"
(= (get agb-mc :conflicts) (list "plan.md"))
true)
(agentic-test
"conflicted merge commits nothing"
(= (agentic/head agb-sp "root-1") agb-rootc2)
true)
(define
agb-res
(agentic/merge-resolve!
agb-sp
"root-1"
"risky-1"
(merge
agb-risk-files
(assoc {} "plan.md" "steady, with one risky idea\n"))
{:message "negotiated"}))
(agentic-test
"merge-resolve! concludes the merge"
(get agb-res :result)
"merged")
(agentic-test
"resolution advances the head"
(= (agentic/head agb-sp "root-1") (get agb-res :cid))
true)
(agentic-test
"resolution has both parents"
(= (git/parents agb-repo (get agb-res :cid)) (list agb-rootc2 agb-rc1))
true)
(agentic-test
"resolved content wins"
(get (git/commit-files agb-repo (get agb-res :cid)) "plan.md")
"steady, with one risky idea\n")
; ---- reviews + edge isolation ----
(agentic/reviews! agb-sp "parser-1" "lexer-1")
(agentic-test
"reviewers edge"
(= (agentic/reviewers agb-sp "lexer-1") (list "parser-1"))
true)
(agentic-test
"reviewing inverse"
(= (agentic/reviewing agb-sp "parser-1") (list "lexer-1"))
true)
(agentic-test
"edge kinds are isolated"
(= (agentic/sub-agents agb-sp "parser-1") (list))
true)