bit-arrays: fix equal?

diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor
index b8ec3f7811317a91e57d757e93d6e4b66ae613f4..fa68b9e9e22094b64b5cd97c46d5a8ed24b0a411 100644 (file)
--- a/basis/bit-arrays/bit-arrays-tests.factor
+++ b/basis/bit-arrays/bit-arrays-tests.factor
@@ -85,3 +85,13 @@ sequences.private tools.test ;
 { 0xa } [ ?{ f t f t } bit-array>integer ] unit-test
 
 { 0x100 } [ ?{ f f f f f f f f t } bit-array>integer ] unit-test
+
+{ t } [
+    2 B{ 0b011 } bit-array boa
+    2 B{ 0b111 } bit-array boa =
+] unit-test
+
+{ f } [
+    3 B{ 0b0 } bit-array boa
+    2 B{ 0b0 } bit-array boa =
+] unit-test

diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index 8116086b75c7fca8673853ac02736d89ac578832..0e7f07b7e0bcb998fc039983e249f57b0e632a9e 100644 (file)
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -78,7 +78,14 @@ M: bit-array like drop dup bit-array? [ >bit-array ] unless ; inline
 M: bit-array new-sequence drop <bit-array> ; inline
 
 M: bit-array equal?
-    over bit-array? [ [ underlying>> ] bi@ sequence= ] [ 2drop f ] if ;
+    over bit-array? [
+        2dup 2length dupd = [
+            [ [ underlying>> ] bi@ ] dip 8 mod [ sequence= ] [
+                [ [ unclip-slice ] bi@ swapd ] dip
+                '[ _ bits ] bi@ = [ sequence= ] [ 2drop f ] if
+            ] if-zero
+        ] [ 3drop f ] if
+    ] [ 2drop f ] if ;
 
 M: bit-array resize
     dupd [ bits>bytes ] [ underlying>> ] bi*