+USING: tools.test alien.syntax specialized-arrays sequences
+alien accessors kernel arrays combinators compiler
+compiler.units classes.struct combinators.smart
+compiler.tree.debugger math libc destructors sequences.private
+multiline eval words vocabs namespaces assocs prettyprint
+alien.data math.vectors definitions compiler.test ;
+FROM: specialized-arrays.private => specialized-array-vocab ;
+FROM: alien.c-types => int float bool uchar char float ulonglong ushort uint
+heap-size ;
+FROM: alien.data => little-endian? ;
IN: specialized-arrays.tests
-USING: tools.test alien.syntax specialized-arrays
-specialized-arrays.private sequences alien.c-types accessors
-kernel arrays combinators compiler compiler.units classes.struct
-combinators.smart compiler.tree.debugger math libc destructors
-sequences.private multiline eval words vocabs namespaces
-assocs prettyprint alien.data math.vectors ;
-FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: int
-SPECIALIZED-ARRAY: bool
-SPECIALIZED-ARRAY: ushort
-SPECIALIZED-ARRAY: char
-SPECIALIZED-ARRAY: uint
-SPECIALIZED-ARRAY: float
-SPECIALIZED-ARRAY: ulonglong
+SPECIALIZED-ARRAYS: bool uchar ushort char uint float ulonglong ;
-[ ulonglong ] [ ulonglong-array{ } element-type ] unit-test
-
-[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
+[ t ] [ { 1 2 3 } int >c-array int-array? ] unit-test
[ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
[ t ] [
- { t f t } >bool-array underlying>>
- { 1 0 1 } "bool" heap-size {
- { 1 [ >char-array ] }
- { 4 [ >uint-array ] }
+ { t f t } bool >c-array underlying>>
+ { 1 0 1 } bool heap-size {
+ { 1 [ char >c-array ] }
+ { 4 [ uint >c-array ] }
} case underlying>> =
] unit-test
[ ushort-array{ 1234 } ] [
- little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array
+ little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array
] unit-test
-[ B{ 210 4 1 } byte-array>ushort-array ] must-fail
+[ B{ 210 4 1 } ushort cast-array ] must-fail
[ { 3 1 3 3 7 } ] [
- int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
+ int-array{ 3 1 3 3 7 } malloc-byte-array 5 int <c-direct-array> >array
] unit-test
+[ float-array{ 0x1.222,222 0x1.111,112 } ]
+[ float-array{ 0x1.222,222,2 0x1.111,111,1 } ] unit-test
+
[ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
[ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
[ ushort-array{ 0 0 0 } ] [
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
- dup [ drop 0 ] change-each
+ [ drop 0 ] map!
] unit-test
STRUCT: test-struct
[ 5/4 ] [
[
- 2 malloc-test-struct-array
+ 2 \ test-struct malloc-array
dup &free drop
1 2 make-point over set-first
3 4 make-point over set-second
[ ] [
[
- 10 malloc-test-struct-array
+ 10 \ test-struct malloc-array
&free drop
] with-destructors
] unit-test
} second
] unit-test
+[ ] [
+ [
+ test-struct specialized-array-vocab forget-vocab
+ ] with-compilation-unit
+] unit-test
+
! Regression
STRUCT: fixed-string { text char[64] } ;
ALIEN: 123 100 <direct-int-array> byte-length
] unit-test
+[ ] [
+ [
+ fixed-string specialized-array-vocab forget-vocab
+ ] with-compilation-unit
+] unit-test
+
! Test prettyprinting
[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
-[ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
+[ "c-array@ int f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
! If the C type doesn't exist, don't generate a vocab
-[ ] [
- [ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit
- "__does_not_exist__" c-types get delete-at
-] unit-test
+SYMBOL: __does_not_exist__
[
- <"
+ """
IN: specialized-arrays.tests
USING: specialized-arrays ;
-SPECIALIZED-ARRAY: __does_not_exist__ "> eval( -- )
+SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- )
] must-fail
[ ] [
- <"
+ """
IN: specialized-arrays.tests
-USING: classes.struct specialized-arrays ;
+USING: alien.c-types classes.struct specialized-arrays ;
STRUCT: __does_not_exist__ { x int } ;
SPECIALIZED-ARRAY: __does_not_exist__
-"> eval( -- )
+""" eval( -- )
] unit-test
[ f ] [
"__does_not_exist__-array{"
- "__does_not_exist__" specialized-array-vocab lookup
+ __does_not_exist__ specialized-array-vocab lookup-word
deferred?
] unit-test
+
+[ ] [
+ [
+ \ __does_not_exist__ forget
+ __does_not_exist__ specialized-array-vocab forget-vocab
+ ] with-compilation-unit
+] unit-test
+
+STRUCT: struct-resize-test { x int } ;
+
+SPECIALIZED-ARRAY: struct-resize-test
+
+[ 40 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
+
+: struct-resize-test-usage ( seq -- seq )
+ [ struct-resize-test <struct> swap >>x ] map
+ \ struct-resize-test >c-array
+ [ x>> ] { } map-as ;
+
+[ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
+
+[ ] [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
+
+[ 80 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
+
+[ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
+
+[ ] [
+ [
+ struct-resize-test specialized-array-vocab forget-vocab
+ \ struct-resize-test-usage forget
+ ] with-compilation-unit
+] unit-test
+
+[ int-array{ 4 5 6 } ] [ 3 6 int-array{ 1 2 3 4 5 6 7 8 } direct-slice ] unit-test
+[ int-array{ 1 2 3 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head ] unit-test
+[ int-array{ 1 2 3 4 5 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head* ] unit-test
+[ int-array{ 4 5 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail ] unit-test
+[ int-array{ 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail* ] unit-test
+
+[ uchar-array{ 0 1 255 } ] [ 3 6 B{ 1 1 1 0 1 255 2 2 2 } direct-slice ] unit-test
+
+[ int-array{ 1 2 3 4 55555 6 7 8 } ] [
+ int-array{ 1 2 3 4 5 6 7 8 }
+ 3 6 pick direct-slice [ 55555 1 ] dip set-nth
+] unit-test
+