sx-git Phase 2: refs — branches/tags/HEAD over persist kv, CAS + reflog (TDD)
Ref value = {:cid} | {:symref}; atomic moves via persist/kv-cas old-value
expect, create-only branches via kv-put-new; bounded symref resolution;
per-ref append-only reflog on the persist log facet. 38/38, total 76/76.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
|||||||
exit 1
|
exit 1
|
||||||
fi
|
fi
|
||||||
|
|
||||||
SUITES=(object)
|
SUITES=(object ref)
|
||||||
|
|
||||||
OUT_JSON="lib/git/scoreboard.json"
|
OUT_JSON="lib/git/scoreboard.json"
|
||||||
OUT_MD="lib/git/scoreboard.md"
|
OUT_MD="lib/git/scoreboard.md"
|
||||||
@@ -33,6 +33,7 @@ run_suite() {
|
|||||||
(load "lib/persist/kv.sx")
|
(load "lib/persist/kv.sx")
|
||||||
(load "lib/artdag/dag.sx")
|
(load "lib/artdag/dag.sx")
|
||||||
(load "lib/git/object.sx")
|
(load "lib/git/object.sx")
|
||||||
|
(load "lib/git/ref.sx")
|
||||||
(epoch 2)
|
(epoch 2)
|
||||||
(eval "(define git-test-pass 0)")
|
(eval "(define git-test-pass 0)")
|
||||||
(eval "(define git-test-fail 0)")
|
(eval "(define git-test-fail 0)")
|
||||||
|
|||||||
197
lib/git/ref.sx
Normal file
197
lib/git/ref.sx
Normal file
@@ -0,0 +1,197 @@
|
|||||||
|
; lib/git/ref.sx — sx-git Phase 2: refs as name -> cid over persist kv.
|
||||||
|
; A ref value is {:cid cid} (direct) or {:symref name} (symbolic). Atomic
|
||||||
|
; update = persist/kv-cas (old-value expect); create-only = kv-put-new.
|
||||||
|
; Every direct-ref move is recorded in an append-only reflog stream
|
||||||
|
; (persist log facet), one stream per ref name.
|
||||||
|
; Requires: lib/git/object.sx (repo handle), lib/persist/kv.sx, log.sx.
|
||||||
|
|
||||||
|
(define git/ref-key (fn (repo name) (str (get repo :prefix) "/ref/" name)))
|
||||||
|
(define
|
||||||
|
git/reflog-stream
|
||||||
|
(fn (repo name) (str (get repo :prefix) "/reflog/" name)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/reflog-record!
|
||||||
|
(fn
|
||||||
|
(repo name old new)
|
||||||
|
(persist/append
|
||||||
|
(get repo :db)
|
||||||
|
(git/reflog-stream repo name)
|
||||||
|
"ref-update"
|
||||||
|
0
|
||||||
|
{:new new :old old})))
|
||||||
|
|
||||||
|
; ---- raw ref values ----
|
||||||
|
(define
|
||||||
|
git/ref-read
|
||||||
|
(fn (repo name) (persist/kv-get (get repo :db) (git/ref-key repo name))))
|
||||||
|
(define git/symref? (fn (v) (and (dict? v) (has-key? v :symref))))
|
||||||
|
|
||||||
|
; direct cid or nil — does NOT follow symrefs
|
||||||
|
(define
|
||||||
|
git/ref-get
|
||||||
|
(fn
|
||||||
|
(repo name)
|
||||||
|
(let ((v (git/ref-read repo name))) (if (dict? v) (get v :cid) nil))))
|
||||||
|
|
||||||
|
; ---- writes ----
|
||||||
|
(define
|
||||||
|
git/ref-set!
|
||||||
|
(fn
|
||||||
|
(repo name cid)
|
||||||
|
(let
|
||||||
|
((old (git/ref-get repo name)))
|
||||||
|
(begin
|
||||||
|
(persist/kv-put (get repo :db) (git/ref-key repo name) {:cid cid})
|
||||||
|
(git/reflog-record! repo name old cid)
|
||||||
|
cid))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/symref-set!
|
||||||
|
(fn
|
||||||
|
(repo name target)
|
||||||
|
(begin
|
||||||
|
(persist/kv-put (get repo :db) (git/ref-key repo name) {:symref target})
|
||||||
|
target)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/ref-delete!
|
||||||
|
(fn
|
||||||
|
(repo name)
|
||||||
|
(persist/kv-delete (get repo :db) (git/ref-key repo name))))
|
||||||
|
|
||||||
|
; ---- resolution (symref chains, bounded) ----
|
||||||
|
(define
|
||||||
|
git/ref-resolve-n
|
||||||
|
(fn
|
||||||
|
(repo name depth)
|
||||||
|
(if
|
||||||
|
(<= depth 0)
|
||||||
|
nil
|
||||||
|
(let
|
||||||
|
((v (git/ref-read repo name)))
|
||||||
|
(cond
|
||||||
|
((git/symref? v)
|
||||||
|
(git/ref-resolve-n repo (get v :symref) (- depth 1)))
|
||||||
|
((dict? v) (get v :cid))
|
||||||
|
(else nil))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/ref-resolve
|
||||||
|
(fn (repo name) (git/ref-resolve-n repo name 10)))
|
||||||
|
|
||||||
|
; ---- atomic update: expected old cid (nil = must not exist) ----
|
||||||
|
(define
|
||||||
|
git/ref-cas!
|
||||||
|
(fn
|
||||||
|
(repo name expected new)
|
||||||
|
(let
|
||||||
|
((res (persist/kv-cas (get repo :db) (git/ref-key repo name) (if (equal? expected nil) nil {:cid expected}) {:cid new})))
|
||||||
|
(if
|
||||||
|
(and (dict? res) (has-key? res :conflict))
|
||||||
|
{:actual (if (dict? (get res :actual)) (get (get res :actual) :cid) nil) :conflict true}
|
||||||
|
(begin (git/reflog-record! repo name expected new) new)))))
|
||||||
|
|
||||||
|
; ---- listing ----
|
||||||
|
(define
|
||||||
|
git/ref-names
|
||||||
|
(fn
|
||||||
|
(repo)
|
||||||
|
(let
|
||||||
|
((pfx (str (get repo :prefix) "/ref/")))
|
||||||
|
(artdag/sort-strings
|
||||||
|
(map
|
||||||
|
(fn (k) (substring k (string-length pfx) (string-length k)))
|
||||||
|
(filter
|
||||||
|
(fn (k) (starts-with? k pfx))
|
||||||
|
(persist/kv-keys (get repo :db))))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/refs-under
|
||||||
|
(fn
|
||||||
|
(repo group)
|
||||||
|
(map
|
||||||
|
(fn (n) (substring n (string-length group) (string-length n)))
|
||||||
|
(filter (fn (n) (starts-with? n group)) (git/ref-names repo)))))
|
||||||
|
|
||||||
|
; ---- branches ----
|
||||||
|
(define git/branch-ref (fn (name) (str "heads/" name)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/branch-set!
|
||||||
|
(fn (repo name cid) (git/ref-set! repo (git/branch-ref name) cid)))
|
||||||
|
(define
|
||||||
|
git/branch-get
|
||||||
|
(fn (repo name) (git/ref-get repo (git/branch-ref name))))
|
||||||
|
(define
|
||||||
|
git/branch-cas!
|
||||||
|
(fn
|
||||||
|
(repo name expected new)
|
||||||
|
(git/ref-cas! repo (git/branch-ref name) expected new)))
|
||||||
|
(define
|
||||||
|
git/branch-delete!
|
||||||
|
(fn (repo name) (git/ref-delete! repo (git/branch-ref name))))
|
||||||
|
(define git/branches (fn (repo) (git/refs-under repo "heads/")))
|
||||||
|
|
||||||
|
; create-only: conflict if the branch already exists
|
||||||
|
(define
|
||||||
|
git/branch-create!
|
||||||
|
(fn
|
||||||
|
(repo name cid)
|
||||||
|
(let
|
||||||
|
((res (persist/kv-put-new (get repo :db) (git/ref-key repo (git/branch-ref name)) {:cid cid})))
|
||||||
|
(if
|
||||||
|
(and (dict? res) (has-key? res :conflict))
|
||||||
|
{:actual (get (get res :actual) :cid) :conflict true}
|
||||||
|
(begin (git/reflog-record! repo (git/branch-ref name) nil cid) cid)))))
|
||||||
|
|
||||||
|
; ---- lightweight tag refs (annotated tag objects live in the object store) ----
|
||||||
|
(define git/tag-refname (fn (name) (str "tags/" name)))
|
||||||
|
(define
|
||||||
|
git/tag-set!
|
||||||
|
(fn (repo name cid) (git/ref-set! repo (git/tag-refname name) cid)))
|
||||||
|
(define
|
||||||
|
git/tag-get
|
||||||
|
(fn (repo name) (git/ref-get repo (git/tag-refname name))))
|
||||||
|
(define git/tag-names (fn (repo) (git/refs-under repo "tags/")))
|
||||||
|
|
||||||
|
; ---- HEAD ----
|
||||||
|
(define
|
||||||
|
git/head-set!
|
||||||
|
(fn (repo branch) (git/symref-set! repo "HEAD" (git/branch-ref branch))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/head-detach!
|
||||||
|
(fn
|
||||||
|
(repo cid)
|
||||||
|
(begin
|
||||||
|
(persist/kv-put (get repo :db) (git/ref-key repo "HEAD") {:cid cid})
|
||||||
|
cid)))
|
||||||
|
|
||||||
|
(define git/head (fn (repo) (git/ref-resolve repo "HEAD")))
|
||||||
|
|
||||||
|
; branch ref name HEAD points at, or nil when detached/unset
|
||||||
|
(define
|
||||||
|
git/head-target
|
||||||
|
(fn
|
||||||
|
(repo)
|
||||||
|
(let
|
||||||
|
((v (git/ref-read repo "HEAD")))
|
||||||
|
(if (git/symref? v) (get v :symref) nil))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
git/detached?
|
||||||
|
(fn
|
||||||
|
(repo)
|
||||||
|
(let
|
||||||
|
((v (git/ref-read repo "HEAD")))
|
||||||
|
(and (dict? v) (has-key? v :cid)))))
|
||||||
|
|
||||||
|
; ---- reflog: oldest-first list of {:old :new} ----
|
||||||
|
(define
|
||||||
|
git/reflog
|
||||||
|
(fn
|
||||||
|
(repo name)
|
||||||
|
(map
|
||||||
|
(fn (e) (persist/event-data e))
|
||||||
|
(persist/read (get repo :db) (git/reflog-stream repo name)))))
|
||||||
@@ -1,8 +1,9 @@
|
|||||||
{
|
{
|
||||||
"suites": {
|
"suites": {
|
||||||
"object": {"pass": 38, "fail": 0}
|
"object": {"pass": 38, "fail": 0},
|
||||||
|
"ref": {"pass": 38, "fail": 0}
|
||||||
},
|
},
|
||||||
"total_pass": 38,
|
"total_pass": 76,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"total": 38
|
"total": 76
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -5,4 +5,5 @@ _Generated by `lib/git/conformance.sh`_
|
|||||||
| Suite | Pass | Fail | Total |
|
| Suite | Pass | Fail | Total |
|
||||||
|-------|-----:|-----:|------:|
|
|-------|-----:|-----:|------:|
|
||||||
| object | 38 | 0 | 38 |
|
| object | 38 | 0 | 38 |
|
||||||
| **Total** | **38** | **0** | **38** |
|
| ref | 38 | 0 | 38 |
|
||||||
|
| **Total** | **76** | **0** | **76** |
|
||||||
|
|||||||
208
lib/git/tests/ref.sx
Normal file
208
lib/git/tests/ref.sx
Normal file
@@ -0,0 +1,208 @@
|
|||||||
|
; Phase 2 — ref: branches/tags/HEAD as name -> cid over persist kv, symbolic
|
||||||
|
; refs, CAS updates with old-value expect, reflog.
|
||||||
|
|
||||||
|
(define grt-db (persist/mem-backend))
|
||||||
|
(define grt (git/repo grt-db))
|
||||||
|
(define grt-c1 (git/write-blob grt "one"))
|
||||||
|
(define grt-c2 (git/write-blob grt "two"))
|
||||||
|
(define grt-c3 (git/write-blob grt "three"))
|
||||||
|
|
||||||
|
; ---- direct refs ----
|
||||||
|
(git-test "ref-get on unset ref is nil" (git/ref-get grt "heads/none") nil)
|
||||||
|
(git-test
|
||||||
|
"ref-set! returns the cid"
|
||||||
|
(git/ref-set! grt "heads/main" grt-c1)
|
||||||
|
grt-c1)
|
||||||
|
(git-test "ref-get reads it back" (git/ref-get grt "heads/main") grt-c1)
|
||||||
|
(git-test
|
||||||
|
"ref-resolve on a direct ref"
|
||||||
|
(git/ref-resolve grt "heads/main")
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"ref-resolve on missing ref is nil"
|
||||||
|
(git/ref-resolve grt "nope")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
; ---- symbolic refs ----
|
||||||
|
(git-test
|
||||||
|
"symref resolves through its target"
|
||||||
|
(begin
|
||||||
|
(git/symref-set! grt "HEAD" "heads/main")
|
||||||
|
(git/ref-resolve grt "HEAD"))
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"symref chain resolves"
|
||||||
|
(begin
|
||||||
|
(git/symref-set! grt "INDIRECT" "HEAD")
|
||||||
|
(git/ref-resolve grt "INDIRECT"))
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"symref cycle is bounded, resolves nil"
|
||||||
|
(begin
|
||||||
|
(git/symref-set! grt "LOOPA" "LOOPB")
|
||||||
|
(git/symref-set! grt "LOOPB" "LOOPA")
|
||||||
|
(git/ref-resolve grt "LOOPA"))
|
||||||
|
nil)
|
||||||
|
(git-test "ref-get does not follow a symref" (git/ref-get grt "HEAD") nil)
|
||||||
|
(git-test
|
||||||
|
"symref? on a raw symref value"
|
||||||
|
(git/symref? (git/ref-read grt "HEAD"))
|
||||||
|
true)
|
||||||
|
|
||||||
|
; ---- CAS ----
|
||||||
|
(git-test
|
||||||
|
"cas create (expected nil) succeeds"
|
||||||
|
(git/ref-cas! grt "heads/dev" nil grt-c1)
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"cas create conflicts when the ref exists"
|
||||||
|
(get (git/ref-cas! grt "heads/dev" nil grt-c2) :conflict)
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"cas conflict reports the actual cid"
|
||||||
|
(get (git/ref-cas! grt "heads/dev" grt-c3 grt-c2) :actual)
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"cas conflict leaves the ref unchanged"
|
||||||
|
(git/ref-get grt "heads/dev")
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"cas with the right expected value moves the ref"
|
||||||
|
(git/ref-cas! grt "heads/dev" grt-c1 grt-c2)
|
||||||
|
grt-c2)
|
||||||
|
(git-test "cas move is visible" (git/ref-get grt "heads/dev") grt-c2)
|
||||||
|
|
||||||
|
; ---- delete ----
|
||||||
|
(git-test
|
||||||
|
"ref-delete! removes the ref"
|
||||||
|
(begin
|
||||||
|
(git/ref-set! grt "heads/tmp" grt-c1)
|
||||||
|
(git/ref-delete! grt "heads/tmp")
|
||||||
|
(git/ref-get grt "heads/tmp"))
|
||||||
|
nil)
|
||||||
|
|
||||||
|
; ---- branch conveniences ----
|
||||||
|
(git-test
|
||||||
|
"branch-create! returns the cid"
|
||||||
|
(git/branch-create! grt "feature" grt-c1)
|
||||||
|
grt-c1)
|
||||||
|
(git-test
|
||||||
|
"branch-create! conflicts on an existing branch"
|
||||||
|
(get (git/branch-create! grt "feature" grt-c2) :conflict)
|
||||||
|
true)
|
||||||
|
(git-test "branch-get" (git/branch-get grt "feature") grt-c1)
|
||||||
|
(git-test
|
||||||
|
"branch-cas! moves the branch"
|
||||||
|
(git/branch-cas! grt "feature" grt-c1 grt-c2)
|
||||||
|
grt-c2)
|
||||||
|
(git-test
|
||||||
|
"branch-set! moves unconditionally"
|
||||||
|
(git/branch-set! grt "feature" grt-c3)
|
||||||
|
grt-c3)
|
||||||
|
(git-test
|
||||||
|
"branch-delete! removes it"
|
||||||
|
(begin (git/branch-delete! grt "feature") (git/branch-get grt "feature"))
|
||||||
|
nil)
|
||||||
|
|
||||||
|
; ---- listing ----
|
||||||
|
(git-test
|
||||||
|
"branches are listed sorted, tags and HEAD excluded"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(let
|
||||||
|
((r (git/repo db)))
|
||||||
|
(begin
|
||||||
|
(git/branch-set! r "zeta" "sx1:z")
|
||||||
|
(git/branch-set! r "alpha" "sx1:a")
|
||||||
|
(git/tag-set! r "v1" "sx1:t")
|
||||||
|
(git/head-set! r "alpha")
|
||||||
|
(= (git/branches r) (list "alpha" "zeta")))))
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"tag-names lists tag refs"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(let
|
||||||
|
((r (git/repo db)))
|
||||||
|
(begin
|
||||||
|
(git/tag-set! r "v2" "sx1:t2")
|
||||||
|
(git/tag-set! r "v1" "sx1:t1")
|
||||||
|
(= (git/tag-names r) (list "v1" "v2")))))
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"tag-get reads a tag ref"
|
||||||
|
(begin (git/tag-set! grt "v1" grt-c1) (git/tag-get grt "v1"))
|
||||||
|
grt-c1)
|
||||||
|
|
||||||
|
; ---- HEAD ----
|
||||||
|
(git-test
|
||||||
|
"head resolves through the current branch"
|
||||||
|
(begin
|
||||||
|
(git/branch-set! grt "main" grt-c2)
|
||||||
|
(git/head-set! grt "main")
|
||||||
|
(git/head grt))
|
||||||
|
grt-c2)
|
||||||
|
(git-test
|
||||||
|
"moving the branch moves head"
|
||||||
|
(begin (git/branch-set! grt "main" grt-c3) (git/head grt))
|
||||||
|
grt-c3)
|
||||||
|
(git-test
|
||||||
|
"head-target names the branch ref"
|
||||||
|
(git/head-target grt)
|
||||||
|
"heads/main")
|
||||||
|
(git-test "detached? false on a symref HEAD" (git/detached? grt) false)
|
||||||
|
(git-test
|
||||||
|
"head-detach! pins a cid"
|
||||||
|
(begin (git/head-detach! grt grt-c1) (git/head grt))
|
||||||
|
grt-c1)
|
||||||
|
(git-test "detached? true after detach" (git/detached? grt) true)
|
||||||
|
(git-test "head-target nil when detached" (git/head-target grt) nil)
|
||||||
|
|
||||||
|
; ---- reflog ----
|
||||||
|
(git-test
|
||||||
|
"reflog of an untouched ref is empty"
|
||||||
|
(= (git/reflog grt "heads/quiet") (list))
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"reflog records create and moves oldest-first"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(let
|
||||||
|
((r (git/repo db)))
|
||||||
|
(begin
|
||||||
|
(git/ref-set! r "heads/x" "sx1:a")
|
||||||
|
(git/ref-set! r "heads/x" "sx1:b")
|
||||||
|
(git/ref-cas! r "heads/x" "sx1:b" "sx1:c")
|
||||||
|
(= (git/reflog r "heads/x") (list {:new "sx1:a" :old nil} {:new "sx1:b" :old "sx1:a"} {:new "sx1:c" :old "sx1:b"})))))
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"branch-create! writes the first reflog entry"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(let
|
||||||
|
((r (git/repo db)))
|
||||||
|
(begin
|
||||||
|
(git/branch-create! r "b" "sx1:a")
|
||||||
|
(= (git/reflog r "heads/b") (list {:new "sx1:a" :old nil})))))
|
||||||
|
true)
|
||||||
|
(git-test
|
||||||
|
"failed cas leaves no reflog entry"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(let
|
||||||
|
((r (git/repo db)))
|
||||||
|
(begin
|
||||||
|
(git/ref-set! r "heads/x" "sx1:a")
|
||||||
|
(git/ref-cas! r "heads/x" "sx1:wrong" "sx1:b")
|
||||||
|
(len (git/reflog r "heads/x")))))
|
||||||
|
1)
|
||||||
|
|
||||||
|
; ---- namespacing ----
|
||||||
|
(git-test
|
||||||
|
"refs are invisible across repo namespaces"
|
||||||
|
(let
|
||||||
|
((db (persist/mem-backend)))
|
||||||
|
(begin
|
||||||
|
(git/branch-set! (git/repo-named db "a") "main" "sx1:a")
|
||||||
|
(git/branch-get (git/repo-named db "b") "main")))
|
||||||
|
nil)
|
||||||
Reference in New Issue
Block a user