--- /dev/null
+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
! (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 -- )
: 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
+
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
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
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
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 ;