giles
2c9e8e4850
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>
175 lines
5.4 KiB
Plaintext
175 lines
5.4 KiB
Plaintext
; 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)
|