coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sx-git extension: git-wire import — the inverse adapter, round-trip law (TDD)

Browse Source 
lib/git/import.sx parses loose payloads back to native objects bottom-up
over an export-set table: tree mode/name/raw-sha triples, ident lines,
header/message split, committer stored only when distinct so export
defaults regenerate identical bytes. Laws verified: export->import->export
is BYTE-IDENTICAL (head sha + every object), imported blobs/default-mode
trees regain their original native cids, 100755/tags/distinct-committer/
multi-line messages all survive. 15/15, total 267/267.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 12:52:24 +00:00
parent e228d462eb
commit 2c9e8e4850
5 changed files with 426 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

174
lib/git/tests/import.sx Normal file
View File

@@ -0,0 +1,174 @@
; Extension — git-wire import (inverse adapter). The law under test:
; export-set -> import-set -> export-set is BYTE-IDENTICAL (same head sha,
; same object table), and imported blobs/trees with default modes get the
; same native cids as the originals.
(define gim-db (persist/mem-backend))
(define gim (git/repo gim-db))
(define gim-hello (git/write-blob gim "hello\n"))
(define gim-sub (git/write-blob gim "sub\n"))
(define
gim-tsub
(git/write
gim
(git/tree (assoc {} "c.txt" (git/tree-entry "blob" gim-sub)))))
(define
gim-t1
(git/write
gim
(git/tree
(assoc
(assoc {} "a.txt" (git/tree-entry "blob" gim-hello))
"sub"
(git/tree-entry "tree" gim-tsub)))))
(define gim-c1 (git/write gim (git/commit gim-t1 (list) {:message "c1" :tz "+0000" :email "ada@sx" :time 1700000000 :author "ada"})))
(define
gim-c2
(git/write
gim
(git/commit
(git/write
gim
(git/tree
(assoc
(assoc
{}
"a.txt"
(git/tree-entry "blob" (git/write-blob gim "hello2\n")))
"sub"
(git/tree-entry "tree" gim-tsub))))
(list gim-c1)
{:message "c2" :tz "+0000" :email "ada@sx" :time 1700000100 :author "ada"})))
; ---- parsing units ----
(git-test
"payload splits type and body"
(git/import-payload (str "blob 6" git/export-nul "hello\n"))
{:type "blob" :body "hello\n"})
(git-test
"ident parses name/email/time/tz"
(= (git/import-ident "ada lovelace <ada@sx> 1700000000 +0100") {:name "ada lovelace" :tz "+0100" :email "ada@sx" :time 1700000000})
true)
(git-test
"raw->hex inverts hex->raw"
(git/raw->hex (git/hex->raw "ce013625030ba8dba906f756967f9e9ca394464a"))
"ce013625030ba8dba906f756967f9e9ca394464a")
(git-test
"tree body parses mode/name/sha triples"
(=
(map
(fn (e) (get e :name))
(git/import-tree-entries
(get
(git/import-payload (get (git/export gim gim-t1) :bytes))
:body)
0
(string-length
(get
(git/import-payload (get (git/export gim gim-t1) :bytes))
:body))
(list)))
(list "a.txt" "sub"))
true)
; ---- the round-trip law ----
(define gim-set1 (git/export-set gim gim-c2))
(define gim-fresh (git/repo-named (persist/mem-backend) "imported"))
(define gim-head (git/import-set gim-fresh gim-set1))
(define gim-set2 (git/export-set gim-fresh gim-head))
(git-test
"wire round-trip: head sha is identical"
(get gim-set2 :head)
(get gim-set1 :head))
(git-test
"wire round-trip: same number of objects"
(=
(len (keys (get gim-set2 :objects)))
(len (keys (get gim-set1 :objects))))
true)
(git-test
"wire round-trip: every sha re-exports byte-identical"
(reduce
(fn
(acc sha)
(and
acc
(equal?
(get (get (get gim-set2 :objects) sha) :bytes)
(get (get (get gim-set1 :objects) sha) :bytes))))
true
(keys (get gim-set1 :objects)))
true)
; ---- native identity on the wire-expressible subset ----
(git-test
"imported blob has the original native cid"
(git/has? gim-fresh gim-hello)
true)
(git-test
"imported default-mode tree has the original native cid"
(git/has? gim-fresh gim-t1)
true)
(git-test
"imported commit graph walks natively"
(= (git/log-messages gim-fresh gim-head) (list "c2\n" "c1\n"))
true)
(git-test
"imported parents map to native cids"
(=
(git/parents gim-fresh gim-head)
(list
(git/cid
(git/read gim-fresh (first (git/parents gim-fresh gim-head))))))
true)
; ---- mode + tag + committer round-trips ----
(git-test
"non-default mode survives the round-trip"
(let
((r (git/repo (persist/mem-backend))))
(let
((t (git/write r (git/tree (assoc {} "x.sh" (merge (git/tree-entry "blob" (git/write-blob r "hello\n")) {:mode "100755"}))))))
(let
((s1 (git/export-set r t)))
(let
((r2 (git/repo-named (persist/mem-backend) "i")))
(get (git/export-set r2 (git/import-set r2 s1)) :head)))))
"54925a269ee97325d7da275bda4250d83b338e65")
(git-test
"annotated tag round-trips through the wire"
(let
((tag (git/write gim (git/tag gim-c1 "v1" {:message "first" :tz "+0000" :email "ada@sx" :time 1700000200 :author "ada"}))))
(let
((s1 (git/export-set gim tag)))
(let
((r2 (git/repo-named (persist/mem-backend) "i")))
(equal?
(get (git/export-set r2 (git/import-set r2 s1)) :head)
(get s1 :head)))))
true)
(git-test
"distinct committer survives the round-trip"
(let
((c (git/write gim (git/commit gim-t1 (list) {:message "handoff" :committer "bob" :committer-tz "+0200" :tz "+0000" :committer-email "bob@sx" :email "ada@sx" :committer-time 1700000300 :time 1700000000 :author "ada"}))))
(let
((s1 (git/export-set gim c)))
(let
((r2 (git/repo-named (persist/mem-backend) "i")))
(equal?
(get (git/export-set r2 (git/import-set r2 s1)) :head)
(get s1 :head)))))
true)
(git-test
"multi-line message round-trips byte-exact"
(let
((c (git/write gim (git/commit gim-t1 (list) {:message "subject\n\nbody line one\nbody line two\n" :tz "+0000" :email "ada@sx" :time 1 :author "ada"}))))
(let
((s1 (git/export-set gim c)))
(let
((r2 (git/repo-named (persist/mem-backend) "i")))
(equal?
(get (git/export-set r2 (git/import-set r2 s1)) :head)
(get s1 :head)))))
true)