sx-git Phase 1: blob/tree/commit/tag as content-addressed typed objects (TDD)
Objects are plain dicts over persist kv, addressed by sx1:<sha256> of the artdag/canon canonical form (sorted dict keys) — native CIDs, extensible fields participate in identity. 38/38. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
241
lib/git/tests/object.sx
Normal file
241
lib/git/tests/object.sx
Normal file
@@ -0,0 +1,241 @@
|
||||
; Phase 1 — object: blob/tree/commit/tag as content-addressed typed objects.
|
||||
; Fixture repo: blobs a/b/c, nested tree (a.txt b.txt sub/c.txt), two commits
|
||||
; (c2 modifies a.txt, parent c1), tag v1 -> c1. Reused as the assertion target.
|
||||
|
||||
(define git-fix-db (persist/mem-backend))
|
||||
(define git-fix (git/repo git-fix-db))
|
||||
|
||||
(define git-fix-blob-a (git/write-blob git-fix "hello\n"))
|
||||
(define git-fix-blob-b (git/write-blob git-fix "world\n"))
|
||||
(define git-fix-blob-c (git/write-blob git-fix "sub\n"))
|
||||
(define git-fix-blob-a2 (git/write-blob git-fix "hello2\n"))
|
||||
|
||||
(define
|
||||
git-fixt-entries3
|
||||
(fn
|
||||
(acid bcid subcid)
|
||||
(assoc
|
||||
(assoc
|
||||
(assoc {} "a.txt" (git/tree-entry "blob" acid))
|
||||
"b.txt"
|
||||
(git/tree-entry "blob" bcid))
|
||||
"sub"
|
||||
(git/tree-entry "tree" subcid))))
|
||||
|
||||
(define
|
||||
git-fix-subtree-cid
|
||||
(git/write
|
||||
git-fix
|
||||
(git/tree
|
||||
(assoc {} "c.txt" (git/tree-entry "blob" git-fix-blob-c)))))
|
||||
|
||||
(define
|
||||
git-fix-tree1-cid
|
||||
(git/write
|
||||
git-fix
|
||||
(git/tree
|
||||
(git-fixt-entries3 git-fix-blob-a git-fix-blob-b git-fix-subtree-cid))))
|
||||
|
||||
(define
|
||||
git-fix-tree2-cid
|
||||
(git/write
|
||||
git-fix
|
||||
(git/tree
|
||||
(git-fixt-entries3 git-fix-blob-a2 git-fix-blob-b git-fix-subtree-cid))))
|
||||
|
||||
(define
|
||||
git-fix-commit1-cid
|
||||
(git/write git-fix (git/commit git-fix-tree1-cid (list) {:message "c1" :time 1 :author "ada"})))
|
||||
|
||||
(define
|
||||
git-fix-commit2-cid
|
||||
(git/write
|
||||
git-fix
|
||||
(git/commit git-fix-tree2-cid (list git-fix-commit1-cid) {:message "c2" :time 2 :author "ada"})))
|
||||
|
||||
(define
|
||||
git-fix-tag-cid
|
||||
(git/write git-fix (git/tag git-fix-commit1-cid "v1" {:message "first" :tagger "ada"})))
|
||||
|
||||
; ---- constructors + types ----
|
||||
(git-test "blob is typed" (git/object-type (git/blob "x")) "blob")
|
||||
(git-test "blob? true on blob" (git/blob? (git/blob "x")) true)
|
||||
(git-test
|
||||
"blob? false on commit"
|
||||
(git/blob? (git/commit "t" (list) {}))
|
||||
false)
|
||||
(git-test "tree? true on tree" (git/tree? (git/tree {})) true)
|
||||
(git-test
|
||||
"commit? true on commit"
|
||||
(git/commit? (git/commit "t" (list) {}))
|
||||
true)
|
||||
(git-test "tag? true on tag" (git/tag? (git/tag "c" "v" {})) true)
|
||||
(git-test "blob-data reads back" (git/blob-data (git/blob "hi")) "hi")
|
||||
|
||||
; ---- cid: deterministic structural identity ----
|
||||
(git-test
|
||||
"cid deterministic"
|
||||
(equal? (git/cid (git/blob "same")) (git/cid (git/blob "same")))
|
||||
true)
|
||||
(git-test
|
||||
"cid differs by content"
|
||||
(equal? (git/cid (git/blob "a")) (git/cid (git/blob "b")))
|
||||
false)
|
||||
(git-test
|
||||
"cid ignores dict insertion order"
|
||||
(equal?
|
||||
(git/cid (assoc (assoc {} :type "blob") :data "x"))
|
||||
(git/cid (assoc (assoc {} :data "x") :type "blob")))
|
||||
true)
|
||||
(git-test
|
||||
"cid carries the native scheme prefix"
|
||||
(starts-with? (git/cid (git/blob "x")) "sx1:")
|
||||
true)
|
||||
|
||||
; ---- write / read / has ----
|
||||
(git-test
|
||||
"write returns the object cid"
|
||||
(equal? git-fix-blob-a (git/cid (git/blob "hello\n")))
|
||||
true)
|
||||
(git-test
|
||||
"read round-trips blob data"
|
||||
(git/blob-data (git/read git-fix git-fix-blob-a))
|
||||
"hello\n")
|
||||
(git-test
|
||||
"read round-trips structurally"
|
||||
(equal? (git/read git-fix git-fix-blob-a) (git/blob "hello\n"))
|
||||
true)
|
||||
(git-test "has? true after write" (git/has? git-fix git-fix-blob-a) true)
|
||||
(git-test "has? false for unknown cid" (git/has? git-fix "sx1:nope") false)
|
||||
(git-test "read unknown cid gives nil" (git/read git-fix "sx1:nope") nil)
|
||||
(git-test
|
||||
"rewrite is idempotent, same cid"
|
||||
(equal? (git/write git-fix (git/blob "hello\n")) git-fix-blob-a)
|
||||
true)
|
||||
|
||||
; ---- structural identity across separately built objects ----
|
||||
(git-test
|
||||
"separately built identical tree shares the cid"
|
||||
(equal?
|
||||
(git/write
|
||||
git-fix
|
||||
(git/tree
|
||||
(git-fixt-entries3 git-fix-blob-a git-fix-blob-b git-fix-subtree-cid)))
|
||||
git-fix-tree1-cid)
|
||||
true)
|
||||
(git-test
|
||||
"changed entry changes the tree cid"
|
||||
(equal? git-fix-tree1-cid git-fix-tree2-cid)
|
||||
false)
|
||||
|
||||
; ---- tree accessors ----
|
||||
(git-test
|
||||
"tree entry lookup by name"
|
||||
(git/entry-cid
|
||||
(git/tree-entry-for (git/read git-fix git-fix-tree1-cid) "a.txt"))
|
||||
git-fix-blob-a)
|
||||
(git-test
|
||||
"tree entry kind"
|
||||
(git/entry-kind
|
||||
(git/tree-entry-for (git/read git-fix git-fix-tree1-cid) "sub"))
|
||||
"tree")
|
||||
(git-test
|
||||
"tree-names sorted"
|
||||
(=
|
||||
(git/tree-names (git/read git-fix git-fix-tree1-cid))
|
||||
(list "a.txt" "b.txt" "sub"))
|
||||
true)
|
||||
|
||||
; ---- commit accessors ----
|
||||
(git-test
|
||||
"commit tree cid"
|
||||
(git/commit-tree (git/read git-fix git-fix-commit1-cid))
|
||||
git-fix-tree1-cid)
|
||||
(git-test
|
||||
"root commit has no parents"
|
||||
(git/commit-parents (git/read git-fix git-fix-commit1-cid))
|
||||
(list))
|
||||
(git-test
|
||||
"child commit records its parent"
|
||||
(git/commit-parents (git/read git-fix git-fix-commit2-cid))
|
||||
(list git-fix-commit1-cid))
|
||||
(git-test
|
||||
"commit author round-trips"
|
||||
(git/commit-author (git/read git-fix git-fix-commit1-cid))
|
||||
"ada")
|
||||
(git-test
|
||||
"commit message round-trips"
|
||||
(git/commit-message (git/read git-fix git-fix-commit2-cid))
|
||||
"c2")
|
||||
(git-test
|
||||
"commit cids differ across history"
|
||||
(equal? git-fix-commit1-cid git-fix-commit2-cid)
|
||||
false)
|
||||
|
||||
; ---- typed extensibility (the reason for native CID) ----
|
||||
(git-test
|
||||
"extra commit field round-trips"
|
||||
(get
|
||||
(git/read
|
||||
git-fix
|
||||
(git/write git-fix (git/commit "t" (list) {:message "m" :co-authored-by "claude"})))
|
||||
:co-authored-by)
|
||||
"claude")
|
||||
(git-test
|
||||
"extra field changes the cid"
|
||||
(equal?
|
||||
(git/cid (git/commit "t" (list) {:m 1}))
|
||||
(git/cid (git/commit "t" (list) {})))
|
||||
false)
|
||||
(git-test
|
||||
"protected keys win over meta"
|
||||
(git/commit-tree (git/commit "t" (list) {:tree "evil"}))
|
||||
"t")
|
||||
|
||||
; ---- tag ----
|
||||
(git-test
|
||||
"tag target"
|
||||
(git/tag-target (git/read git-fix git-fix-tag-cid))
|
||||
git-fix-commit1-cid)
|
||||
(git-test "tag name" (git/tag-name (git/read git-fix git-fix-tag-cid)) "v1")
|
||||
(git-test
|
||||
"tag? on read-back"
|
||||
(git/tag? (git/read git-fix git-fix-tag-cid))
|
||||
true)
|
||||
|
||||
; ---- full walk: commit -> tree -> subtree -> blob ----
|
||||
(git-test
|
||||
"walk commit to nested blob"
|
||||
(git/blob-data
|
||||
(git/read
|
||||
git-fix
|
||||
(git/entry-cid
|
||||
(git/tree-entry-for
|
||||
(git/read
|
||||
git-fix
|
||||
(git/entry-cid
|
||||
(git/tree-entry-for
|
||||
(git/read
|
||||
git-fix
|
||||
(git/commit-tree (git/read git-fix git-fix-commit1-cid)))
|
||||
"sub")))
|
||||
"c.txt"))))
|
||||
"sub\n")
|
||||
|
||||
; ---- repos are namespaced within one backend ----
|
||||
(git-test
|
||||
"objects are invisible across repo namespaces"
|
||||
(let
|
||||
((db (persist/mem-backend)))
|
||||
(let
|
||||
((ra (git/repo-named db "a")) (rb (git/repo-named db "b")))
|
||||
(let ((cid (git/write-blob ra "x"))) (git/has? rb cid))))
|
||||
false)
|
||||
(git-test
|
||||
"same content, same cid in any repo"
|
||||
(let
|
||||
((db (persist/mem-backend)))
|
||||
(equal?
|
||||
(git/write-blob (git/repo-named db "a") "x")
|
||||
(git/write-blob (git/repo-named db "b") "x")))
|
||||
true)
|
||||
Reference in New Issue
Block a user