@@ -50,6 +50,9 @@

                #:fiveam

                #:co.fwoar.cl-git)

   :serial t

+  :perform (test-op (o c)

+                    (unless (symbol-call :fiveam '#:run! :fwoar.cl-git)

+                      (error "some tests failed")))

   :components ((:module "tests"

                 :components ((:file "tests")

                              (:file "branch-resolution" :depends-on ("tests"))

@@ -40,6 +40,26 @@

             :sum (expt 2 n))))

 (defun trace-bases (pack delta)

+  (assert (typep delta 'delta))

+  (let* ((offset (second (base delta)))

+         (o (extract-object-at-pos pack

+                                   offset

+                                   (make-instance 'git-ref

+                                                  :hash "00000000"

+                                                  :repo nil)))

+         (obj (serapeum:assocdr :object-data o))

+         (raw (serapeum:assocdr :raw-data o)))

+    (if (typep obj 'delta)

+        (let ((next (trace-bases pack obj)))

+          (length next)

+          (apply-commands next

+                          (commands delta)))

+        (let ((base (apply-commands raw

+                                    (commands delta))))

+          (length base)

+          base))))

+

+(defun get-bases (pack delta)

   (if (typep delta 'delta)

       (let* ((offset (second (base delta)))

              (o (extract-object-at-pos pack

@@ -47,14 +67,9 @@

                                        (make-instance 'git-ref

                                                       :hash "00000000"

                                                       :repo nil)))

-             (obj (serapeum:assocdr :object-data o))

-             (raw (serapeum:assocdr :raw-data o)))

-        (if (typep obj 'delta)

-            (apply-commands (trace-bases pack obj)

-                            (commands delta))

-            (apply-commands (trace-bases pack raw)

-                            (commands delta))))

-      delta))

+             (obj (serapeum:assocdr :object-data o)))

+        (cons delta (get-bases pack obj)))

+      (list delta)))

 (defun partition-commands (data)

   (let ((idx 0))

@@ -98,9 +113,13 @@

 (defun apply-commands (base commands)

   (flexi-streams:with-output-to-sequence (s)

     (flet ((do-copy (offset cnt)

+             #+(or)

+             (format t "DOING :COPY ~d ~d~%" offset cnt)

              (write-sequence (subseq base offset (+ offset cnt))

                              s))

            (do-add (data)

+             #+(or)

+             (format t "DOING :ADD ~d~%" (length data))

              (write-sequence data s)))

       (loop for (command . args) in commands

             when (eql command :copy) do

@@ -108,6 +127,19 @@

             when (eql command :add) do

               (apply #'do-add args)))))

+(defun get-ofs-delta-offset-streaming (buf)

+  (let* ((idx 0))

+    (flet ((advance ()

+             (read-byte buf)))

+      (loop

+        for c = (advance)

+        for ofs = (logand c 127) then (+ (ash (1+ ofs)

+                                              7)

+                                         (logand c 127))

+        while (> (logand c 128) 0)

+        finally

+           (return (values (- ofs) idx))))))

+

 (defun get-ofs-delta-offset (buf)

   (let* ((idx 0))

     (flet ((advance ()

@@ -138,23 +170,19 @@

       (values (bit-vector->int result)

               (length parts)))))

-(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from packfile)

-  (multiple-value-bind (offset consumed) (get-ofs-delta-offset s)

-    (let ((compressed-data (chipz:decompress

-                            nil

-                            (chipz:make-dstate 'chipz:zlib)

-                            (subseq s consumed))))

-      (multiple-value-bind (src-size consumed-1) (decode-size compressed-data)

-        (multiple-value-bind (delta-size consumed-2) (decode-size (subseq compressed-data

-                                                                          consumed-1))

-          (make-ofs-delta (list packfile

-                                (+ offset-from offset))

-                          (partition-commands (subseq compressed-data

-                                                      (+ consumed-1

-                                                         consumed-2)))

-                          repository

-                          src-size

-                          delta-size))))))

+(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from packfile base)

+  (multiple-value-bind (src-size consumed-1) (decode-size s)

+    (multiple-value-bind (delta-size consumed-2) (decode-size (subseq s

+                                                                      consumed-1))

+      (make-ofs-delta (list packfile

+                            (+ offset-from base))

+                      (partition-commands (subseq s

+                                                  (+ consumed-1

+                                                     consumed-2)))

+                      repository

+                      src-size

+                      delta-size))))

+

 (defmethod -extract-object-of-type ((type (eql :ref-delta)) s repository &key offset-from)

   (make-ref-delta offset-from

                   (partition-commands s)

@@ -46,23 +46,62 @@

         (return-from find-object-in-pack-files

           (values pack mid sha))))))

+(defun raw-object-for-ref (packed-ref)

+  (let ((pack (packed-ref-pack packed-ref)))

+    (with-pack-streams (i p) pack

+      (file-position p (read-4-byte-offset pack (packed-ref-offset packed-ref)))

+      (get-object-from-pack p))))

+

+(defun get-object-from-pack (s)

+  (let* ((metadata (fwoar.bin-parser:extract-high s))

+         (type (object-type->sym (get-object-type metadata)))

+         (size (get-object-size metadata)))

+    (case type

+      (:ref-delta (error ":ref-delta not implemented yet"))

+      (:ofs-delta (get-ofs-delta-offset-streaming s)))

+    (let ((decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))

+      (values (concatenate

+               '(vector fwoar.cl-git.types:octet)

+               (ecase type

+                 (:commit #.(babel:string-to-octets "commit" :encoding :ascii))

+                 (:blob #.(babel:string-to-octets "blob" :encoding :ascii))

+                 (:tree #.(babel:string-to-octets "tree" :encoding :ascii)))

+               #(32)

+               (babel:string-to-octets (prin1-to-string size ):encoding :ascii)

+               #(0)

+               decompressed)

+              size

+              (length decompressed)))))

+

+(defun get-ofs-delta-offset-streaming (buf)

+  (let* ((idx 0))

+    (flet ((advance ()

+             (read-byte buf)))

+      (loop

+        for c = (advance)

+        for ofs = (logand c 127) then (+ (ash (1+ ofs)

+                                              7)

+                                         (logand c 127))

+        while (> (logand c 128) 0)

+        finally

+           (return (values (- ofs) idx))))))

+

 (defun read-object-from-pack (s repository ref)

   (let* ((pos (file-position s))

          (metadata (fwoar.bin-parser:extract-high s))

          (type (object-type->sym (get-object-type metadata)))

          (size (get-object-size metadata))

-         (decompressed (if (member type '(:ofs-delta :ref-delta))

-                           (let ((buffer (make-array size :element-type '(unsigned-byte 8))))

-                             (read-sequence buffer s)

-                             buffer)

-                           (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))

-         (object-data (extract-object-of-type type decompressed repository pos (pathname s) ref)))

+         (delta-base (case type

+                       (:ref-delta (error ":ref-delta not implemented yet"))

+                       (:ofs-delta (get-ofs-delta-offset-streaming s))))

+         (decompressed (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))

+         (object-data (extract-object-of-type type decompressed repository pos (pathname s) ref delta-base)))

     (list (cons :type (object-type->sym type))

           (cons :decompressed-size size)

           (cons :object-data object-data)

           (cons :raw-data decompressed))))

-(defun extract-object-of-type (type s repository pos packfile ref)

+(defun extract-object-of-type (type s repository pos packfile ref delta-base)

   (with-simple-restart (continue "Skip object of type ~s at position ~d"

                                  type

                                  pos)

@@ -71,7 +110,8 @@

                              repository

                              :offset-from pos

                              :packfile packfile

-                             :hash (ref-hash ref))))

+                             :hash (ref-hash ref)

+                             :base delta-base)))

 (defun pack-offset-for-object (index-file obj-number)

   (let ((offset-offset (getf index-file

@@ -111,7 +151,8 @@

                                 repo

                                 0

                                 nil

-                                ref)))))

+                                ref

+                                nil)))))

 (defgeneric extract-object (object)

   (:method ((object loose-ref))

@@ -1,17 +1,12 @@

 (in-package :fwoar.cl-git)

-(defmacro with-pack-streams ((idx-sym pack-sym) pack &body body)

-  (alexandria:once-only (pack)

-    `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet)

-       (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet)

-         ,@body))))

-

 (defun seek-to-object-in-pack (pack idx-stream pack-stream obj-number)

   (let* ((toc (idx-toc pack))

          (offset-offset (getf toc :4-byte-offsets)))

     (file-position idx-stream (+ offset-offset (* 4 obj-number)))

     (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int idx-stream)))

-      (file-position pack-stream object-offset-in-pack))))

+      (values (file-position pack-stream object-offset-in-pack)

+              object-offset-in-pack))))

 (defun extract-object-metadata-from-pack (pack obj-number)

   (with-pack-streams (s p) pack

@@ -32,10 +27,12 @@

           'vector))

 (defun get-object-size (bytes)

-  (let ((first (elt bytes 0))

-        (rest (subseq bytes 1)))

-    (logior (ash (fwoar.bin-parser:be->int rest) 4)

-            (logand first 15))))

+  (loop for c across bytes

+        for next = (logand c 15) then (logand c #x7f)

+        for shift = 0 then (if (= shift 0) 4 (+ shift 7))

+        for size = next then (+ size (ash next shift))

+        while (> (logand c #x80) 0)

+        finally (return size)))

 (defun get-object-type (bytes)

   (let ((first (elt bytes 0)))

@@ -98,6 +98,12 @@

 (defun pack (index pack repository)

   (fw.lu:new 'pack index pack repository))

+(defmacro with-pack-streams ((idx-sym pack-sym) pack &body body)

+  (alexandria:once-only (pack)

+    `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet)

+       (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet)

+         ,@body))))

+

 (defgeneric pack-files (repo)

   (:method ((repo git-repository))

     (mapcar (serapeum:op

@@ -158,8 +158,26 @@

 (defparameter *fake-repo-2* :fwoar.cl-git.git-objects.pack-2)

+(defclass fake-ref-2 (fake-ref)

+  ())

+(defun fake-ref-2 (repo hash)

+  (fwoar.lisputils:new 'fake-ref-2 repo hash))

+(defmethod fwoar.cl-git::packed-ref-pack ((ref fake-ref-2))

+  (let* ((pack-file (asdf:system-relative-pathname

+                     :co.fwoar.cl-git/tests

+                     "tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.pack"))

+         (index-file (asdf:system-relative-pathname

+                      :co.fwoar.cl-git/tests

+                      "tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.idx")))

+    (make-instance 'fwoar.cl-git::pack

+                   :repository nil

+                   :index index-file

+                   :pack pack-file)))

+(defmethod fwoar.cl-git::packed-ref-offset ((ref fake-ref-2))

+  (nth-value 1 (fwoar.cl-git::find-sha-in-pack (fwoar.cl-git::packed-ref-pack ref)

+                                               (fwoar.cl-git::ref-hash ref))))

 (defmethod fwoar.cl-git::ref ((repo (eql *fake-repo-2*)) hash)

-  (fake-ref repo hash))

+  (fake-ref-2 repo hash))

 (defmethod fwoar.cl-git::pack-files ((repo (eql *fake-repo-2*)))

   (list

    (let* ((pack-file (asdf:system-relative-pathname

@@ -187,6 +205,78 @@

                                (fwoar.cl-git::packed-ref *fake-repo-2* ref)))))))

     ))

+(fiveam:def-test test-pack-roundtrip ()

+  (let ((shas '("b7df27f1c873f5796462cdce8aabf46c1b3e3ff2"

+                "d468a84b54e73968d9426af96c1944c80ffa3a4f"

+                "4cc1ee4919056be337922f0a57e0bfe7281b8c57"

+                "4d4ea31b3d349ffd06e97469743f824578555edf"

+                "7df80f061ae5bf6177a1c0888d085281be2801e1"

+                "846489f7ae91bfaf0c78a6939b177697a89a81d0"

+                "bc7ccfbd98e684d9188b6833ec39f7d1d72edfdf"

+                "6089dc804725925c30d621c3d2f72c8b1b14bc17"

+                "500325f0022a9adc41929b58fbb5c2d55b60524b"

+                "72870f874f3ef712d9bea352e300b9b5f6aa60ee"

+                "0c24c8f931ad5c0d2e5add01710678abddd3ec03"

+                "e499f64d2ead6d14d74fe0f484d06f33bbd38261"

+                "efe60b9f578c4966cb2258ace1661edd080ca0dc"

+                "821ddf96c37e65ccc9a0f4bfe2b8ac6e255a2cb6"

+                "077088c8c359489ed1f6d8e441ec76438076542e"

+                "e1f7c67a8774d65bb941eeb2b41f71f333fa1a94"

+                "ff33293b415cc1907a6071650d045b3dffd8e5c0"

+                "e98a5866a0148fe573197e8c48a543fc3039f1bc"

+                "f09f6f1b30fd3579649f8abf23719901496accde"

+                "692f03101cd8ebf6830618805217b6348ddfd3a8"

+                "f710cf28a9f511911e1def85c4cb98bfbcfd9017"

+                "0b3ed8597e1968306c3732f7507256694357009f"

+                "88e003ecce9e9420632d0bab857270819e922674"

+                "5c205fb851671ff0938c86d7c0cc742f2ca2d32f"

+                "8f6a890959795d2b340615a074170ce404d7f2b9"

+                "e079ee4a351de0841c09f87dffdee333ef936673"

+                "347e97b1efa866e3bd00bbfb68c5b660e378f3b5"

+                "ad9b8a82065f70aac3da61e845ab2cd37a71e649"

+                "83674eea1c0a2f2df2886b38b9539ed1193b00c3"

+                "e623be68f6fd0c36dee0145a4c95dbbf85174774"

+                "a7c6e622cca243456481ffbeafaab739e4687681"

+                "b0bbceded2a17389a9a6ddc765398a257199c78e"

+                "82c268c1e7afe543ac14bf2748df53a729fa35cb"

+                "2fb0a2fc57327dc6a533b596a0643ad991847b3b"

+                "f1a12e8a19691afcd5ee08d615a1b4d14b5051f9"

+                "991d0162019ac2e21592553a10ab16eb337222d8"

+                "94acd859d12ae611e631cfd66b7ed164d6b5ac89"

+                "f115dea85d331cb5c01e247d77886bba2690e726"

+                "488cc8612e7b24a1737a260b10bff0037b55636e"

+                "be4ef77fd7da17393e02ef933e8d21e67be7fbec"

+                "a84a7f712398c1659f2e809d903ae51b44cf7f4a"

+                "8a9fe9f77149f74fed5c05388be8e5ffd4a31678"

+                "e69de29bb2d1d6434b8b29ae775ad8c2e48c5391"

+                "0306819e780fa57dc3bf6b99a0a059670b605ae0"

+                "a52be677adeda194bcdfdd12740f00535b6b0997"

+                "fb265bb344fee602dc175d1d5eac6bdc2d013a10"

+                "9db42f61f21e11529b9bc1c52ee118c03d663c04"

+                "197e10755343900cfbcb7fc6d863d4b3231e74d4"

+                "83324cbcb0ef5b778588cc6ba547c43c46bff8c6"

+                "88988d16b44fc03054807882783ed176162228f4"

+                "d2818bb88b8ec5235a8ae91309f31ba58d941d42"

+                "c1b83741c4dc3104f1686c20b143300db0a0e258"

+                "7e24a6a7a4349497fce06830fa132e9a8ef6fd06"

+                "9567a5825bf65b7e90d6f9a02574a00b53af9171"

+                "b757bb704b4c7a54622b7bd197ad5c1ea51ef2cc"

+                "ccccc07814249fc7a129bfffd07f09704d0f017b"

+                "a4b5b13466bb8e80d6f8015e2bf27667533ea441"

+                "3d894d70b6e1036034f22654408a382b6e303335"

+                "fed9d70ab2441d8c8abf19648668f885ed5a4986"

+                "b50c3a28d0bdab4d922d4b363cada4c582349178"

+                "4b825dc642cb6eb9a060e54bf8d69288fbee4904"

+                "71da880a8be0356b67d593fac348dfe429d1e0b6"

+                "cab7cafae3b61c5b101ee914cd4f5c8357e77fad"

+                "f03a8d1b4cea085ee9555037d09bca2dbfb990cb")))

+    (loop for commit in shas

+          for obj = (fwoar.cl-git::raw-object-for-ref

+                     (fwoar.cl-git::ref :fwoar.cl-git.git-objects.pack-2 commit))

+          do (5am:is (equal (crypto:byte-array-to-hex-string

+                             (crypto:digest-sequence :sha1 obj))

+                            commit)))))

+

 (fiveam:def-test pack-file-apply-delta-commands ()

   (flet ((test-ref (ref)

            (let* ((extracted-ref

@@ -209,14 +299,10 @@

     (test-ref "9776df71b5ddf298c56e99b7291f9e68906cf049")

-    #+(or) ;; broken

     (test-ref "31576396aff0fff28f69e0ef84571c0dc8cc43ec")

-    #+(or) ;; broken

     (test-ref "c516dfc248544509c3ae58e3a8c2ab81c225aa9c")

-    #+(or) ;; broken

     (test-ref "53d13ed284f8b57297d1b216e2bab7fb43f8db60")

-    #+(or) ;; broken

     (test-ref "912d31a169ddf1fca122d4c6fe1b1e6be7cd1176")))