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:
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