checksums: Ugly fix for incremental checksums. Add randomized unit tests to ensure...

diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor
index 77be6761f701a50583938419fd25de419a6d3eca..d1cf83723f482594c36474038337a0721f85c24f 100644 (file)
--- a/basis/checksums/common/common.factor
+++ b/basis/checksums/common/common.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-arrays byte-vectors checksums grouping io
 io.backend io.binary io.encodings.binary io.files kernel make
-math sequences ;
+math sequences locals ;
 IN: checksums.common
 
 : calculate-pad-length ( length -- length' )
@@ -38,19 +38,32 @@ GENERIC: checksum-block ( bytes checksum-state -- )
 
 GENERIC: get-checksum ( checksum-state -- value )
 
-: add-checksum-bytes ( checksum-state data -- checksum-state' )
-    [
-        over bytes>> [ push-all ] keep
-        [ dup length pick block-size>> >= ]
-        [
-            over block-size>> cut-slice [
-                over checksum-block
-                [ block-size>> ] keep [ + ] change-bytes-read
-            ] dip
-        ] while
-        >byte-vector >>bytes
-    ] keep
-    length 64 mod [ + ] curry change-bytes-read ;
+: next-level ( n size -- n' )
+    2dup mod [ + ] [ - + ] if-zero ; inline
+
+! Update the bytes-read before calculating checksum in case checksum uses
+! this in the calculation.
+:: add-checksum-bytes ( state data -- state' )
+    state block-size>> :> block-size
+    state bytes>> length :> initial-len
+    data length :> data-len
+    initial-len data-len + :> total-len
+    total-len block-size /mod :> ( n extra )
+    data state bytes>> [ push-all ] keep :> all-bytes
+    n zero? [
+        state [ data-len + ] change-bytes-read drop
+    ] [
+        all-bytes block-size <groups> [ length 64 = ] partition [
+            [ state [ block-size next-level ] change-bytes-read drop state checksum-block ] each
+            BV{ } clone state bytes<<
+        ] [
+            [
+                first
+                [ length state [ + ] change-bytes-read drop ]
+                [ >byte-vector state bytes<< ] bi
+            ] unless-empty
+        ] bi*
+    ] if state ;
 
 : add-checksum-stream ( checksum-state stream -- checksum-state )
     [ [ add-checksum-bytes ] each-block ] with-input-stream ;

diff --git a/basis/checksums/sha/sha-tests.factor b/basis/checksums/sha/sha-tests.factor
index 982a2caf171218aa000d26dbbc4d26a1ae58ffbb..82ab54482ec6574f5aab5f2df414e4d2210c1069 100644 (file)
--- a/basis/checksums/sha/sha-tests.factor
+++ b/basis/checksums/sha/sha-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays checksums checksums.common checksums.sha
 checksums.sha.private io.encodings.binary io.streams.byte-array
-kernel math.parser sequences tools.test ;
+kernel math.parser sequences tools.test random ;
 IN: checksums.sha.tests
 
 : test-checksum ( text identifier -- checksum )
@@ -75,3 +75,37 @@ CONSTANT: bytes-b B{ 1 2 3 4 5 6 7 8 }
     sha1 initialize-checksum-state bytes-a bytes-b append add-checksum-bytes get-checksum
     sha1 initialize-checksum-state bytes-a add-checksum-bytes bytes-b add-checksum-bytes get-checksum =
 ] unit-test
+
+: incremental-checksum ( algorithm seqs -- checksum )
+    [ initialize-checksum-state ] dip
+    [ add-checksum-bytes ] each get-checksum ;
+
+: one-go-checksum ( algorithm seqs -- checksum )
+    [ initialize-checksum-state ] dip
+    concat add-checksum-bytes get-checksum ;
+
+ERROR: checksums-differ algorithm seq incremental-checksum one-go-checksum ;
+: compare-checksum-calculations ( algorithm seq -- ? )
+    2dup [ incremental-checksum ] [ one-go-checksum ] 2bi 2dup = [
+        2drop 2drop t
+    ] [
+        checksums-differ
+    ] if ;
+
+{ t } [ 100 iota [ drop sha1 100 [ 100 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+{ t } [ 100 iota [ drop sha1 20 [ 20 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+{ t } [ 100 iota [ drop sha1 10 [ 10 random random-bytes ] replicate compare-checksum-calculations ] all? ] unit-test
+
+{ t } [ sha1 {
+    B{ 105 27 166 214 73 114 110 }
+    B{ 39 162 16 218 0 42 }
+    B{ 129 235 197 233 }
+    B{ 61 29 254 66 67 }
+    B{ 28 236 253 45 240 123 134 191 22 }
+    B{ 220 27 205 59 27 48 }
+    B{ 249 2 196 177 74 195 12 131 91 }
+    B{ 174 102 159 89 250 38 230 5 }
+    B{ 126 22 231 253 118 64 }
+    B{ 185 127 20 126 123 35 204 243 43 }
+    } compare-checksum-calculations
+] unit-test