1 USING: tools.test alien.syntax specialized-arrays sequences
2 alien accessors kernel arrays combinators compiler
3 compiler.units classes.struct combinators.smart
4 compiler.tree.debugger math libc destructors sequences.private
5 multiline eval words vocabs namespaces assocs prettyprint
6 alien.data math.vectors definitions compiler.test ;
7 FROM: specialized-arrays.private => specialized-array-vocab ;
8 FROM: alien.c-types => int float bool char float ulonglong ushort uint
9 heap-size little-endian? ;
10 IN: specialized-arrays.tests
12 SPECIALIZED-ARRAY: int
13 SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
15 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
17 [ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
19 [ 2 ] [ int-array{ 1 2 3 } second ] unit-test
22 { t f t } >bool-array underlying>>
23 { 1 0 1 } bool heap-size {
29 [ ushort-array{ 1234 } ] [
30 little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast
33 [ B{ 210 4 1 } ushort-array-cast ] must-fail
36 int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
39 [ float-array{ HEX: 1.222,222 HEX: 1.111,112 } ]
40 [ float-array{ HEX: 1.222,222,2 HEX: 1.111,111,1 } ] unit-test
42 [ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
44 [ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
46 [ ushort-array{ 0 0 0 } ] [
47 3 ALIEN: 123 100 <direct-ushort-array> new-sequence
55 SPECIALIZED-ARRAY: test-struct
58 1 test-struct-array{ } new-sequence length
61 [ V{ test-struct } ] [
62 [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
65 : make-point ( x y -- struct )
66 test-struct <struct-boa> ;
70 1 2 make-point over set-first
71 3 4 make-point over set-second
72 0 [ [ x>> ] [ y>> ] bi / + ] reduce
77 2 malloc-test-struct-array
79 1 2 make-point over set-first
80 3 4 make-point over set-second
81 0 [ [ x>> ] [ y>> ] bi / + ] reduce
85 [ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
89 10 malloc-test-struct-array
94 [ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
96 [ S{ test-struct f 12 20 } ] [
98 S{ test-struct f 4 20 }
99 S{ test-struct f 12 20 }
100 S{ test-struct f 20 20 }
106 test-struct specialized-array-vocab forget-vocab
107 ] with-compilation-unit
111 STRUCT: fixed-string { text char[64] } ;
113 SPECIALIZED-ARRAY: fixed-string
115 [ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } ] [
116 ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
119 ! Ensure that byte-length works with direct arrays
121 ALIEN: 123 100 <direct-int-array> byte-length
126 fixed-string specialized-array-vocab forget-vocab
127 ] with-compilation-unit
130 ! Test prettyprinting
131 [ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
132 [ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
134 ! If the C type doesn't exist, don't generate a vocab
135 SYMBOL: __does_not_exist__
139 IN: specialized-arrays.tests
140 USING: specialized-arrays ;
142 SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- )
147 IN: specialized-arrays.tests
148 USING: alien.c-types classes.struct specialized-arrays ;
150 STRUCT: __does_not_exist__ { x int } ;
152 SPECIALIZED-ARRAY: __does_not_exist__
157 "__does_not_exist__-array{"
158 __does_not_exist__ specialized-array-vocab lookup
164 \ __does_not_exist__ forget
165 __does_not_exist__ specialized-array-vocab forget-vocab
166 ] with-compilation-unit
169 STRUCT: struct-resize-test { x int } ;
171 SPECIALIZED-ARRAY: struct-resize-test
173 [ 40 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
175 : struct-resize-test-usage ( seq -- seq )
176 [ struct-resize-test <struct> swap >>x ] map
177 >struct-resize-test-array
180 [ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
182 [ ] [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
184 [ 80 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
186 [ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
190 struct-resize-test specialized-array-vocab forget-vocab
191 \ struct-resize-test-usage forget
192 ] with-compilation-unit