classes.struct: fix some bugs in binary-zero?, add unit tests

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 4ed7d9b446deb1716e6fa17433d0811bc2633fc8..ab354bb569f913815b4e8189b08dd9c8397dfbe4 100644 (file)
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -9,6 +9,7 @@ system tools.test parser lexer eval layouts generic.single classes
 vocabs ;
 FROM: math => float ;
 FROM: specialized-arrays.private => specialized-array-vocab ;
+FROM: classes.struct.private => binary-zero? ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: int
@@ -474,3 +475,32 @@ CONSULT: struct-test-delegate struct-test-delegator del>> ;
         7 >>a
         8 >>b
 ] unit-test
+
+SPECIALIZED-ARRAY: struct-test-foo
+
+[ t ] [ 0 binary-zero? ] unit-test
+[ f ] [ 1 binary-zero? ] unit-test
+[ f ] [ -1 binary-zero? ] unit-test
+[ t ] [ 0.0 binary-zero? ] unit-test
+[ f ] [ 1.0 binary-zero? ] unit-test
+[ f ] [ -0.0 binary-zero? ] unit-test
+[ t ] [ C{ 0.0 0.0 } binary-zero? ] unit-test
+[ f ] [ C{ 1.0 0.0 } binary-zero? ] unit-test
+[ f ] [ C{ -0.0 0.0 } binary-zero? ] unit-test
+[ f ] [ C{ 0.0 1.0 } binary-zero? ] unit-test
+[ f ] [ C{ 0.0 -0.0 } binary-zero? ] unit-test
+[ t ] [ f binary-zero? ] unit-test
+[ t ] [ 0 <alien> binary-zero? ] unit-test
+[ f ] [ 1 <alien> binary-zero? ] unit-test
+[ f ] [ B{ } binary-zero? ] unit-test
+[ t ] [ S{ struct-test-foo f 0 0 f } binary-zero? ] unit-test
+[ f ] [ S{ struct-test-foo f 1 0 f } binary-zero? ] unit-test
+[ f ] [ S{ struct-test-foo f 0 1 f } binary-zero? ] unit-test
+[ f ] [ S{ struct-test-foo f 0 0 t } binary-zero? ] unit-test
+[ t t f ] [
+    struct-test-foo-array{
+        S{ struct-test-foo f 0 0 f }
+        S{ struct-test-foo f 0 0 f }
+        S{ struct-test-foo f 1 0 f }
+    } [ first binary-zero? ] [ second binary-zero? ] [ third binary-zero? ] tri
+] unit-test

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index b0f315b3359231830d50f8b7394215d5fe2bb7f3..43578ba2a57afcc58761ee642f8323a27d902587 100644 (file)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -11,6 +11,7 @@ namespaces assocs vocabs.parser math.functions
 classes.struct.bit-accessors bit-arrays
 stack-checker.dependencies system layouts ;
 FROM: delegate.private => group-words slot-group-words ;
+FROM: math => float ;
 QUALIFIED: math
 IN: classes.struct
 
@@ -237,10 +238,12 @@ M: struct byte-length class "struct-size" word-prop ; foldable
 <PRIVATE
 GENERIC: binary-zero? ( value -- ? )
 
-M: object binary-zero? drop f ;
-M: f binary-zero? drop t ;
-M: number binary-zero? 0 = ;
-M: struct binary-zero? >c-ptr [ 0 = ] all? ;
+M: object binary-zero? drop f ; inline
+M: f binary-zero? drop t ; inline
+M: integer binary-zero? zero? ; inline
+M: float binary-zero? double>bits zero? ; inline
+M: complex binary-zero? >rect [ binary-zero? ] both? ; inline
+M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
 
 : struct-needs-prototype? ( class -- ? )
     struct-slots [ initial>> binary-zero? ] all? not ;

diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 5fa88e39a22b0c718704dd7b64ab8d8802419829..9754fd2abcbab5dcb32a0440c31392ac68dff64f 100644 (file)
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -137,14 +137,16 @@ M: pointer underlying-type
         bi
     ] "" make ;
 
-PRIVATE>
-
-: direct-slice ( from to seq -- seq' )
-    check-slice
+: direct-slice-unsafe ( from to seq -- seq' )
     [ nip nth-c-ptr ]
     [ drop swap - ]
     [ 2nip ] 3tri direct-like ; inline
 
+PRIVATE>
+
+: direct-slice ( from to seq -- seq' )
+    check-slice direct-slice-unsafe ; inline
+
 : direct-head ( seq n -- seq' ) (head) direct-slice ; inline
 : direct-tail ( seq n -- seq' ) (tail) direct-slice ; inline
 : direct-head* ( seq n -- seq' ) from-end direct-head ; inline