]> gitweb.factorcode.org Git - factor.git/commitdiff
alien.data: make binary-zero? public and move it from classes.struct.private
authorJoe Groff <arcata@gmail.com>
Fri, 11 Jun 2010 00:05:43 +0000 (17:05 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 14 Jun 2010 00:34:16 +0000 (19:34 -0500)
basis/alien/data/data-tests.factor [new file with mode: 0644]
basis/alien/data/data.factor
basis/classes/struct/struct-tests.factor
basis/classes/struct/struct.factor

diff --git a/basis/alien/data/data-tests.factor b/basis/alien/data/data-tests.factor
new file mode 100644 (file)
index 0000000..d17675e
--- /dev/null
@@ -0,0 +1,35 @@
+USING: alien alien.c-types alien.data alien.syntax\r
+classes.struct kernel sequences specialized-arrays\r
+tools.test ;\r
+IN: alien.data.tests\r
+\r
+STRUCT: foo { a int } { b void* } { c bool } ;\r
+\r
+SPECIALIZED-ARRAY: foo\r
+\r
+[ t ] [ 0 binary-zero? ] unit-test\r
+[ f ] [ 1 binary-zero? ] unit-test\r
+[ f ] [ -1 binary-zero? ] unit-test\r
+[ t ] [ 0.0 binary-zero? ] unit-test\r
+[ f ] [ 1.0 binary-zero? ] unit-test\r
+[ f ] [ -0.0 binary-zero? ] unit-test\r
+[ t ] [ C{ 0.0 0.0 } binary-zero? ] unit-test\r
+[ f ] [ C{ 1.0 0.0 } binary-zero? ] unit-test\r
+[ f ] [ C{ -0.0 0.0 } binary-zero? ] unit-test\r
+[ f ] [ C{ 0.0 1.0 } binary-zero? ] unit-test\r
+[ f ] [ C{ 0.0 -0.0 } binary-zero? ] unit-test\r
+[ t ] [ f binary-zero? ] unit-test\r
+[ t ] [ 0 <alien> binary-zero? ] unit-test\r
+[ f ] [ 1 <alien> binary-zero? ] unit-test\r
+[ f ] [ B{ } binary-zero? ] unit-test\r
+[ t ] [ S{ foo f 0 f f } binary-zero? ] unit-test\r
+[ f ] [ S{ foo f 1 f f } binary-zero? ] unit-test\r
+[ f ] [ S{ foo f 0 ALIEN: 8 f } binary-zero? ] unit-test\r
+[ f ] [ S{ foo f 0 f t } binary-zero? ] unit-test\r
+[ t t f ] [\r
+    foo-array{\r
+        S{ foo f 0 f f }\r
+        S{ foo f 0 f f }\r
+        S{ foo f 1 f f }\r
+    } [ first binary-zero? ] [ second binary-zero? ] [ third binary-zero? ] tri\r
+] unit-test\r
index 81b53a1b39ee6bb16f935e17d9d85cd0efaee1be..2f5e4b72c6803d0e8404a59137a3f4c254b076c1 100644 (file)
@@ -1,8 +1,9 @@
 ! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
 USING: accessors alien alien.c-types alien.arrays alien.strings
 arrays byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math sequences words
-macros combinators generalizations ;
+io.files io.streams.memory kernel libc math math.functions 
+sequences words macros combinators generalizations ;
+QUALIFIED: math
 IN: alien.data
 
 GENERIC: require-c-array ( c-type -- )
@@ -106,3 +107,12 @@ PRIVATE>
 : with-out-parameters ( c-types quot finish -- values )
     [ [ drop (local-allots) ] [ swap out-parameters ] 2bi ] dip call
     (cleanup-allot) ; inline
+
+GENERIC: binary-zero? ( value -- ? )
+
+M: object binary-zero? drop f ; inline
+M: f binary-zero? drop t ; inline
+M: integer binary-zero? zero? ; inline
+M: math:float binary-zero? double>bits zero? ; inline
+M: complex binary-zero? >rect [ binary-zero? ] both? ; inline
+
index ab354bb569f913815b4e8189b08dd9c8397dfbe4..8bdfb8dd57852c049e857904b09e71b02f38f524 100644 (file)
@@ -9,7 +9,6 @@ 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
@@ -476,31 +475,3 @@ CONSULT: struct-test-delegate struct-test-delegator del>> ;
         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
index 43578ba2a57afcc58761ee642f8323a27d902587..c15e21f65184650c6063a8c9c62ccf265b67d526 100644 (file)
@@ -11,7 +11,6 @@ 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
 
@@ -232,19 +231,11 @@ M: struct-bit-slot-spec compute-slot-offset
 PRIVATE>
 
 M: struct byte-length class "struct-size" word-prop ; foldable
+M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
 
 ! class definition
 
 <PRIVATE
-GENERIC: binary-zero? ( value -- ? )
-
-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 ;