1 ! (c)Joe Groff bsd license
2 USING: accessors alien alien.c-types alien.libraries
3 alien.structs.fields alien.syntax ascii classes.struct combinators
4 destructors io.encodings.utf8 io.pathnames io.streams.string
5 kernel libc literals math multiline namespaces prettyprint
6 prettyprint.config see sequences specialized-arrays.ushort
7 system tools.test compiler.tree.debugger struct-arrays
8 classes.tuple.private specialized-arrays.direct.int
10 IN: classes.struct.tests
13 : libfactor-ffi-tests-path ( -- string )
14 "resource:" (normalize-path)
16 { [ os winnt? ] [ "libfactor-ffi-test.dll" ] }
17 { [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
18 { [ os unix? ] [ "libfactor-ffi-test.so" ] }
21 "f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
23 "f-stdcall" libfactor-ffi-tests-path "stdcall" add-library
26 SYMBOL: struct-test-empty
28 [ [ struct-test-empty { } define-struct-class ] with-compilation-unit ]
29 [ struct-must-have-slots? ] must-fail-with
31 STRUCT: struct-test-foo
33 { y int initial: 123 }
36 STRUCT: struct-test-bar
37 { w ushort initial: HEX: ffff }
38 { foo struct-test-foo } ;
40 [ 12 ] [ struct-test-foo heap-size ] unit-test
41 [ 12 ] [ struct-test-foo <struct> byte-length ] unit-test
42 [ 16 ] [ struct-test-bar heap-size ] unit-test
43 [ 123 ] [ struct-test-foo <struct> y>> ] unit-test
44 [ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test
47 1 2 3 t struct-test-foo <struct-boa> struct-test-bar <struct-boa>
56 [ 7654 ] [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
57 [ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
59 UNION-STRUCT: struct-test-float-and-bits
63 [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
64 [ 4 ] [ struct-test-float-and-bits heap-size ] unit-test
66 [ 123 ] [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
68 STRUCT: struct-test-string-ptr
73 struct-test-string-ptr <struct>
74 "hello world" utf8 malloc-string &free >>x
79 [ "S{ struct-test-foo { y 7654 } }" ]
82 [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
86 [ "S{ struct-test-foo f 0 7654 f }" ]
89 [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
93 [ <" USING: classes.struct ;
94 IN: classes.struct.tests
95 STRUCT: struct-test-foo
96 { x char initial: 0 } { y int initial: 123 } { z bool } ;
98 [ [ struct-test-foo see ] with-string-writer ] unit-test
100 [ <" USING: classes.struct ;
101 IN: classes.struct.tests
102 UNION-STRUCT: struct-test-float-and-bits
103 { f float initial: 0.0 } { bits uint initial: 0 } ;
105 [ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
129 } ] [ "struct-test-foo" c-type fields>> ] unit-test
146 } ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
148 STRUCT: struct-test-equality-1
150 STRUCT: struct-test-equality-2
155 struct-test-equality-1 <struct> 5 >>x
156 struct-test-equality-1 malloc-struct &free 5 >>x =
162 struct-test-equality-1 <struct> 5 >>x
163 struct-test-equality-2 malloc-struct &free 5 >>y =
167 STRUCT: struct-test-ffi-foo
172 FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
174 [ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test
176 STRUCT: struct-test-array-slots
178 { y ushort[6] initial: ushort-array{ 2 3 5 7 11 13 } }
181 [ 11 ] [ struct-test-array-slots <struct> y>> 4 swap nth ] unit-test
184 struct-test-array-slots <struct>
185 [ y>> [ 8 3 ] dip set-nth ]
186 [ y>> ushort-array{ 2 3 5 8 11 13 } sequence= ] bi
189 STRUCT: struct-test-optimization
190 { x { "int" 3 } } { y int } ;
192 [ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
194 [ 3 struct-test-optimization <direct-struct-array> third y>> ]
195 { <tuple> <tuple-boa> memory>struct y>> } inlined?
198 [ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
201 [ struct-test-optimization memory>struct x>> second ]
202 { memory>struct x>> <direct-int-array> <tuple> <tuple-boa> } inlined?
205 [ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
207 [ f ] [ struct-test-foo <struct> dup clone [ >c-ptr ] bi@ eq? ] unit-test