From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 1 Nov 2023 03:19:20 +0000 (-0700)
Subject: bit-arrays: fix equal?
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=fd09fc222233e06d1f8c7a915a7a1d43e16456eb

bit-arrays: fix equal?
---

diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor
index b8ec3f7811..fa68b9e9e2 100644
--- 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 8116086b75..0e7f07b7e0 100644
--- 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*