]> gitweb.factorcode.org Git - factor.git/commitdiff
git: Reduce duplication and add better tests.
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 5 Feb 2021 23:52:23 +0000 (17:52 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 28 Feb 2021 05:51:58 +0000 (23:51 -0600)
extra/git/git-tests.factor
extra/git/git.factor

index 596e88e7e96a6a67bcf5c8405672e60a7c287919..bfe173f3cccd5a20a6194cb73e4d1d50ff90c83d 100644 (file)
@@ -21,13 +21,6 @@ IN: git.tests
         @
     ] with-empty-test-git-repo ; inline
 
-{ "hello" } [
-    commit new
-    "author hello\n"
-    [ parse-git-lines ] with-string-reader
-    author>>
-] unit-test
-
 { "refs/heads/master" } [
     [ git-head-ref ] with-empty-test-git-repo
 ] unit-test
@@ -45,3 +38,67 @@ IN: git.tests
         { "git" "log" } run-process-stdout print
     ] with-zero-byte-file-repo
 ] unit-test
+
+
+{
+    T{ commit
+        { tree "517e33595c3238dbffb4ce494390eb0a36de9604" }
+        { parents "1b744404f3a19be816dc36334d070488e1f2b20e" }
+        { author
+            "Doug Coleman <doug.coleman@gmail.com> 1612484963 -0600"
+        }
+        { committer
+            "Doug Coleman <doug.coleman@gmail.com> 1612485414 -0600"
+        }
+        { message
+            "git: Fix parsing of gpgsig and clean up code.\n\nThey don't tell you that gpgsigs exist, take up many lines, and that you\nneed to keep reading while lines begin with a space."
+        }
+    }
+} [
+"tree 517e33595c3238dbffb4ce494390eb0a36de9604
+parent 1b744404f3a19be816dc36334d070488e1f2b20e
+author Doug Coleman <doug.coleman@gmail.com> 1612484963 -0600
+committer Doug Coleman <doug.coleman@gmail.com> 1612485414 -0600
+
+git: Fix parsing of gpgsig and clean up code.
+
+They don't tell you that gpgsigs exist, take up many lines, and that you
+need to keep reading while lines begin with a space."
+    commit parse-new-git-object
+] unit-test
+
+{
+    T{ commit
+        { tree "6622ae8805e7278666a932015e93f143cbb4caf8" }
+        { parents "71ad025aaf2b888119d4ac080cf5ac4c8c3a0b52" }
+        { author
+            "Doug Coleman <doug.coleman@gmail.com> 1573952316 -0600"
+        }
+        { committer "GitHub <noreply@github.com> 1573952316 -0600" }
+        { gpgsig
+            "-----BEGIN PGP SIGNATURE-----\n\nwsBcBAABCAAQBQJd0Js8CRBK7hj4Ov3rIwAAdHIIAK+7IlWjQF9NBXEMYiciO8DO\nAWgAaGu3ZOh+mXQtvBWqU7OInrcVUQwmo/W1eN/h7ZZS2+dGgAAO4/RxflZ0PaOo\nZnvPAVshNYL03KZSaruXtTs6z1ypoimy1Z89087OGwgTTY2AFDBoUeCEwmm7sTJ6\njWPhq6VlMszisdgqQrk5IiErDHtnm3mteiERTrIKTAeeT/bZuU0BF7eYVvgVLyLu\n/NFSmuEp9619c70KSM4NBG3KjepTW5T6wV/CwaMeoE2gNlj7ehgxZ0zkQg2m4Tpp\nVFiT4niYSekChldDoMJs9A5LZGwoU1QjzCknbfia24747q6qYW5EBK7Df5OhH08=\n=f5p9\n-----END PGP SIGNATURE-----\n"
+        }
+        { message
+            "Add description of '-help' switch to documentation. (#2221)"
+        }
+    }
+} [
+"tree 6622ae8805e7278666a932015e93f143cbb4caf8
+parent 71ad025aaf2b888119d4ac080cf5ac4c8c3a0b52
+author Doug Coleman <doug.coleman@gmail.com> 1573952316 -0600
+committer GitHub <noreply@github.com> 1573952316 -0600
+gpgsig -----BEGIN PGP SIGNATURE-----
+ wsBcBAABCAAQBQJd0Js8CRBK7hj4Ov3rIwAAdHIIAK+7IlWjQF9NBXEMYiciO8DO
+ AWgAaGu3ZOh+mXQtvBWqU7OInrcVUQwmo/W1eN/h7ZZS2+dGgAAO4/RxflZ0PaOo
+ ZnvPAVshNYL03KZSaruXtTs6z1ypoimy1Z89087OGwgTTY2AFDBoUeCEwmm7sTJ6
+ jWPhq6VlMszisdgqQrk5IiErDHtnm3mteiERTrIKTAeeT/bZuU0BF7eYVvgVLyLu
+ /NFSmuEp9619c70KSM4NBG3KjepTW5T6wV/CwaMeoE2gNlj7ehgxZ0zkQg2m4Tpp
+ VFiT4niYSekChldDoMJs9A5LZGwoU1QjzCknbfia24747q6qYW5EBK7Df5OhH08=
+ =f5p9
+ -----END PGP SIGNATURE-----
+
+Add description of '-help' switch to documentation. (#2221)"
+    commit parse-new-git-object
+] unit-test
\ No newline at end of file
index 3e1f389760d07a005029e54e0e3cb23065388817..61cc9a6f5a1362c0084181fbf4036fca693fbdf7 100644 (file)
@@ -2,12 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs assocs.extras calendar
 calendar.format checksums checksums.sha combinators
-combinators.smart compression.zlib constructors fry grouping io
+combinators.smart compression.zlib constructors grouping io
 io.binary io.directories io.encodings.binary io.encodings.string
 io.encodings.utf8 io.files io.files.info io.pathnames
 io.streams.byte-array io.streams.peek kernel math math.bitwise
-math.parser math.statistics memoize namespaces random sequences
-sequences.extras splitting strings ;
+math.parser namespaces random sequences sequences.extras
+splitting splitting.monotonic strings ;
 IN: git
 
 ERROR: byte-expected offset ;
@@ -68,12 +68,8 @@ CONSTRUCTOR: <index-entry> index-entry ( ctime mtime dev ino mode uid gid size s
 : read-index-entry-v2 ( -- seq )
     4 read be> 4 read be> 2array
     4 read be> 4 read be> 2array
-    4 read be>
-    4 read be>
-    4 read be>
-    4 read be>
-    4 read be>
-    4 read be>
+    4 read be> 4 read be> 4 read be>
+    4 read be> 4 read be> 4 read be>
     20 read bytes>hex-string
     2 read be> { 0 } read-until drop [ utf8 decode ] [ length ] bi
     7 + 8 mod dup zero? [ 8 swap - ] unless read drop
@@ -83,7 +79,6 @@ TUPLE: git-index magic version entries checksum ;
 CONSTRUCTOR: <git-index> git-index ( magic version entries checksum -- obj ) ;
 
 ERROR: unhandled-git-version n ;
-ERROR: unhandled-git-index-trailing-bytes bytes ;
 
 : git-index-contents ( -- git-index )
     "index" make-git-path binary [
@@ -131,7 +126,7 @@ CONSTRUCTOR: <tree> tree ( -- obj ) ;
     3 cut [ string>number ] bi@
     [ hours ] [ minutes ] bi* time+ ;
 
-: date>string ( seq -- string )
+: git-date>string ( seq -- string )
     last2
     [ string>number unix-time>timestamp ]
     [ gmt-offset>duration [ time+ ] [ >>gmt-offset ] bi ] bi*
@@ -141,7 +136,7 @@ CONSTRUCTOR: <tree> tree ( -- obj ) ;
     {
         [ hash>> "commit " prepend print ]
         [ author>> "Author: " prepend " " split 2 head* " " join print ]
-        [ author>> " " split date>string "Date:   " prepend print ]
+        [ author>> " " split git-date>string "Date:   " prepend print ]
         [ message>> "\n" split [ "    " prepend ] map "\n" join nl print nl ]
     } cleave ;
 
@@ -154,75 +149,41 @@ ERROR: unknown-field name parameter ;
         { "author" [ >>author ] }
         { "committer" [ >>committer ] }
         { "gpgsig" [ >>gpgsig ] }
-        { "" [ >>message ] }
+        { "message" [ >>message ] }
         [ unknown-field ]
-    } case ;
-
-: parse-git-value ( accum -- value next-key ch )
-    "\n" read-until drop
-    over push "\s\n" read-until 2dup 2array { "" CHAR: \s } = [
-        2drop parse-git-value
+    } case ; inline
+
+: git-string>assoc ( string -- assoc )
+    "\n\n" split1 [
+        string-lines [ nip first CHAR: \s = ] monotonic-split
+        [
+            dup length 1 = [
+                first " " split1 2array
+            ] [
+                [ first " " split1 ]
+                [ rest [ rest ] map ] bi
+                swap prefix "\n" join 2array
+            ] if
+        ] map
     ] [
-        [ "\n" join ] 2dip
-    ] if ;
+        "message" swap 2array
+    ] bi* suffix ;
 
-: parse-git-key-vals ( obj key ch -- obj )
-    {
-        { CHAR: \s [ V{ } clone parse-git-value [ set-git-object-field ] 2dip parse-git-key-vals ] }
-        { CHAR: \n [ contents set-git-object-field ] }
-        { f [ drop ] }
-    } case ;
-
-: parse-git-lines ( obj -- obj )
-    "\s\n" read-until parse-git-key-vals ;
-
-: parse-commit ( bytes -- commit )
-    " " split1
-    [ "commit" assert= ] [ string>number read ] bi*
-    utf8 [
-        commit new parse-git-lines
-    ] with-byte-reader ;
-
-ERROR: key-already-set value key assoc ;
-: set-at-once ( value key assoc -- )
-    2dup key? [ key-already-set ] [ set-at ] if ;
-
-: parse-object-line>assoc ( hashtable -- hashtable )
-    "\s\n" read-until {
-        { CHAR: \s [ [ "\r\n" read-until* ] dip pick over "parent" = [ push-at ] [ set-at-once ] if parse-object-line>assoc ] }
-        { CHAR: \n [ drop contents "message" pick set-at ] }
-    } case ;
-
-: assoc>commit ( assoc -- commit )
-    [ commit new ] dip {
-        [ "tree" of >>tree ]
-        [ "parent" of >>parents ]
-        [ "author" of >>author ]
-        [ "committer" of >>committer ]
-        [ "message" of >>message ]
-    } cleave ;
+: parse-new-git-object ( string class -- commit )
+    new swap git-string>assoc [ first2 set-git-object-field ] each ; inline
 
 ERROR: unknown-git-object obj ;
-: assoc>git-object ( assoc -- git-object )
-    {
-        { [ "committer" over key? ] [ assoc>commit ] }
-        [ unknown-git-object ]
-    } cond ;
-
-: parse-object-bytes>assoc ( obj -- hashtable )
-    utf8 [
-        H{ } clone parse-object-line>assoc assoc>git-object
-    ] with-byte-reader ;
-
-: parse-tree ( bytes -- commit )
-    utf8 [ tree new parse-git-lines ] with-byte-reader ;
 
 : parse-object ( bytes -- git-obj )
     utf8 [
         { 0 } read-until 0 = drop dup " " split1 drop {
             { "blob" [ "unimplemented blob parsing" throw ] }
-            { "commit" [ parse-commit ] }
-            { "tree" [ parse-tree ] }
+            { "commit" [
+                " " split1
+                [ "commit" assert= ] [ string>number read ] bi*
+                commit parse-new-git-object
+            ] }
+            { "tree" [ tree parse-new-git-object ] }
             [ unknown-git-object ]
         } case
     ] with-byte-reader ;
@@ -299,37 +260,14 @@ CONSTRUCTOR: <copy> copy ( offset size -- copy ) ;
             7 bits read <insert>
         ] [
             [ 0 0 ] dip
-
-            dup 0x01 mask? [
-                [ read1* bitor ] 2dip
-            ] when
-
-            dup 0x02 mask? [
-                [ read1* 8 shift bitor ] 2dip
-            ] when
-
-            dup 0x04 mask? [
-                [ read1* 16 shift bitor ] 2dip
-            ] when
-
-            dup 0x08 mask? [
-                [ read1* 24 shift bitor ] 2dip
-            ] when
-
-            dup 0x10 mask? [
-                [ read1* bitor ] dip
-            ] when
-
-            dup 0x20 mask? [
-                [ read1* 8 shift bitor ] dip
-            ] when
-
-            dup 0x40 mask? [
-                [ read1* 16 shift bitor ] dip
-            ] when
-
-            drop [ 65536 ] when-zero
-            <copy>
+            dup 0x01 mask? [ [ read1* bitor ] 2dip ] when
+            dup 0x02 mask? [ [ read1* 8 shift bitor ] 2dip ] when
+            dup 0x04 mask? [ [ read1* 16 shift bitor ] 2dip ] when
+            dup 0x08 mask? [ [ read1* 24 shift bitor ] 2dip ] when
+            dup 0x10 mask? [ [ read1* bitor ] dip ] when
+            dup 0x20 mask? [ [ read1* 8 shift bitor ] dip ] when
+            dup 0x40 mask? [ [ read1* 16 shift bitor ] dip ] when
+            drop [ 65536 ] when-zero <copy>
         ] if
     ] [
         f
@@ -382,7 +320,7 @@ SYMBOL: initial-offset
     tell-input initial-offset [
         read-type-length first2 swap {
             { 1 [ 256 + read uncompress parse-object ] }
-            { 6 [ read-offset-delta first2 do-deltas parse-object-bytes>assoc ] }
+            { 6 [ read-offset-delta first2 do-deltas parse-object ] }
             ! { 7 [ B read-sha1-delta ] }
             [ number>string "unknown packed type: " prepend throw ]
         } case
@@ -405,8 +343,7 @@ TUPLE: pack magic version count objects sha1 ;
         [ peek1 ] [ read-packed ] produce 2array
     ] with-file-reader ;
 
-: git-read-idx ( sha -- obj )
-    make-idx-path parse-idx ;
+: git-read-idx ( sha -- obj ) make-idx-path parse-idx ;
 
 ! Broken for now
 ! : git-read-pack ( sha -- obj ) make-pack-path parse-pack ;
@@ -473,9 +410,7 @@ ERROR: expected-ref got ;
 : git-head-ref ( -- sha1 ) "HEAD" git-ref ;
 : git-log-for-ref ( ref -- log ) git-line git-read-object ;
 : git-head-object ( -- commit ) git-head-ref git-log-for-ref ;
-: git-config ( -- config )
-    "config" make-git-path ;
-
+: git-config ( -- config ) "config" make-git-path ;
 
 SYMBOL: parents
 ERROR: repeated-parent-hash hash ;