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 uchar char float ulonglong ushort uint
10 FROM: alien.data => little-endian? ;
11 IN: specialized-arrays.tests
13 SPECIALIZED-ARRAY: int
14 SPECIALIZED-ARRAYS: bool uchar ushort char uint float ulonglong ;
16 { t } [ { 1 2 3 } int >c-array int-array? ] unit-test
18 { t } [ int-array{ 1 2 3 } int-array? ] unit-test
20 { 2 } [ int-array{ 1 2 3 } second ] unit-test
23 { t f t } bool >c-array underlying>>
24 { 1 0 1 } bool heap-size {
25 { 1 [ char >c-array ] }
26 { 4 [ uint >c-array ] }
30 { ushort-array{ 1234 } } [
31 little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array
34 [ B{ 210 4 1 } ushort cast-array ] must-fail
37 int-array{ 3 1 3 3 7 } malloc-byte-array [ &free 5 int <c-direct-array> >array ] with-destructors
40 { float-array{ 0x1.222,222p0 0x1.111,112p0 } }
41 [ float-array{ 0x1.222,222,2p0 0x1.111,111,1p0 } ] unit-test
43 { f } [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
45 { f } [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
47 { ushort-array{ 0 0 0 } } [
48 3 ALIEN: 123 100 <direct-ushort-array> new-sequence
56 SPECIALIZED-ARRAY: test-struct
59 1 test-struct-array{ } new-sequence length
62 { V{ test-struct } } [
63 [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
66 : make-point ( x y -- struct )
71 1 2 make-point over set-first
72 3 4 make-point over set-second
73 0 [ [ x>> ] [ y>> ] bi / + ] reduce
78 2 \ test-struct malloc-array
80 1 2 make-point over set-first
81 3 4 make-point over set-second
82 0 [ [ x>> ] [ y>> ] bi / + ] reduce
86 { } [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
90 10 \ test-struct malloc-array
95 { 15 } [ 15 10 <test-struct-array> resize length ] unit-test
97 { S{ test-struct f 12 20 } } [
99 S{ test-struct f 4 20 }
100 S{ test-struct f 12 20 }
101 S{ test-struct f 20 20 }
107 test-struct specialized-array-vocab forget-vocab
108 ] with-compilation-unit
112 STRUCT: fixed-string { text char[64] } ;
114 SPECIALIZED-ARRAY: fixed-string
116 { { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } } [
117 ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
120 ! Ensure that byte-length works with direct arrays
122 ALIEN: 123 100 <direct-int-array> byte-length
127 fixed-string specialized-array-vocab forget-vocab
128 ] with-compilation-unit
131 ! Test prettyprinting
132 { "int-array{ 1 2 3 }" } [ int-array{ 1 2 3 } unparse ] unit-test
133 { "c-array@ int f 100" } [ f 100 <direct-int-array> unparse ] unit-test
135 ! If the C type doesn't exist, don't generate a vocab
136 SYMBOL: __does_not_exist__
140 IN: specialized-arrays.tests
141 USING: specialized-arrays ;
143 SPECIALIZED-ARRAY: __does_not_exist__ " eval( -- )
148 IN: specialized-arrays.tests
149 USING: alien.c-types classes.struct specialized-arrays ;
151 STRUCT: __does_not_exist__ { x int } ;
153 SPECIALIZED-ARRAY: __does_not_exist__
158 "__does_not_exist__-array{"
159 __does_not_exist__ specialized-array-vocab lookup-word
165 \ __does_not_exist__ forget
166 __does_not_exist__ specialized-array-vocab forget-vocab
167 ] with-compilation-unit
170 STRUCT: struct-resize-test { x int } ;
172 SPECIALIZED-ARRAY: struct-resize-test
174 { 40 } [ 10 <struct-resize-test-array> byte-length ] unit-test
176 : struct-resize-test-usage ( seq -- seq )
177 [ struct-resize-test <struct> swap >>x ] map
178 \ struct-resize-test >c-array
181 { { 10 20 30 } } [ { 10 20 30 } struct-resize-test-usage ] unit-test
183 { } [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
185 { 80 } [ 10 <struct-resize-test-array> byte-length ] unit-test
187 { { 10 20 30 } } [ { 10 20 30 } struct-resize-test-usage ] unit-test
191 struct-resize-test specialized-array-vocab forget-vocab
192 \ struct-resize-test-usage forget
193 ] with-compilation-unit
196 { int-array{ 4 5 6 } } [ 3 6 int-array{ 1 2 3 4 5 6 7 8 } direct-slice ] unit-test
197 { int-array{ 1 2 3 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head ] unit-test
198 { int-array{ 1 2 3 4 5 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head* ] unit-test
199 { int-array{ 4 5 6 7 8 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail ] unit-test
200 { int-array{ 6 7 8 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail* ] unit-test
202 { uchar-array{ 0 1 255 } } [ 3 6 B{ 1 1 1 0 1 255 2 2 2 } direct-slice ] unit-test
204 { int-array{ 1 2 3 4 55555 6 7 8 } } [
205 int-array{ 1 2 3 4 5 6 7 8 }
206 3 6 pick direct-slice [ 55555 1 ] dip set-nth