2010-04-12 21:29:47 -04:00
|
|
|
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 ;
|
2010-02-24 10:50:31 -05:00
|
|
|
FROM: alien.c-types => int float bool char float ulonglong ushort uint
|
|
|
|
heap-size little-endian? ;
|
2010-04-12 21:29:47 -04:00
|
|
|
IN: specialized-arrays.tests
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
SPECIALIZED-ARRAY: int
|
2009-10-09 11:43:37 -04:00
|
|
|
SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
|
2009-09-21 00:16:02 -04:00
|
|
|
|
2008-11-14 21:18:16 -05:00
|
|
|
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
|
|
|
|
|
|
|
[ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
|
|
|
|
|
|
|
|
[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
|
|
|
|
|
2009-05-08 22:34:28 -04:00
|
|
|
[ t ] [
|
|
|
|
{ t f t } >bool-array underlying>>
|
2009-11-20 02:37:24 -05:00
|
|
|
{ 1 0 1 } bool heap-size {
|
2009-05-08 22:34:28 -04:00
|
|
|
{ 1 [ >char-array ] }
|
|
|
|
{ 4 [ >uint-array ] }
|
|
|
|
} case underlying>> =
|
|
|
|
] unit-test
|
2008-12-02 21:35:20 -05:00
|
|
|
|
|
|
|
[ ushort-array{ 1234 } ] [
|
2010-05-18 23:09:34 -04:00
|
|
|
little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast
|
2008-12-02 21:35:20 -05:00
|
|
|
] unit-test
|
|
|
|
|
2010-05-18 23:09:34 -04:00
|
|
|
[ B{ 210 4 1 } ushort-array-cast ] must-fail
|
2009-02-06 05:37:28 -05:00
|
|
|
|
|
|
|
[ { 3 1 3 3 7 } ] [
|
|
|
|
int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
|
2009-09-03 03:24:03 -04:00
|
|
|
] unit-test
|
|
|
|
|
2009-10-17 01:07:08 -04:00
|
|
|
[ float-array{ HEX: 1.222,222 HEX: 1.111,112 } ]
|
|
|
|
[ float-array{ HEX: 1.222,222,2 HEX: 1.111,111,1 } ] unit-test
|
|
|
|
|
2009-09-03 03:24:03 -04:00
|
|
|
[ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
|
|
|
|
|
2009-09-08 00:51:25 -04:00
|
|
|
[ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
|
|
|
|
|
2009-09-04 23:01:55 -04:00
|
|
|
[ ushort-array{ 0 0 0 } ] [
|
|
|
|
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
|
2009-10-27 23:32:56 -04:00
|
|
|
[ drop 0 ] map!
|
2009-09-08 00:51:25 -04:00
|
|
|
] unit-test
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
STRUCT: test-struct
|
|
|
|
{ x int }
|
|
|
|
{ y int } ;
|
|
|
|
|
|
|
|
SPECIALIZED-ARRAY: test-struct
|
|
|
|
|
|
|
|
[ 1 ] [
|
|
|
|
1 test-struct-array{ } new-sequence length
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ V{ test-struct } ] [
|
|
|
|
[ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
: make-point ( x y -- struct )
|
|
|
|
test-struct <struct-boa> ;
|
|
|
|
|
|
|
|
[ 5/4 ] [
|
|
|
|
2 <test-struct-array>
|
|
|
|
1 2 make-point over set-first
|
|
|
|
3 4 make-point over set-second
|
|
|
|
0 [ [ x>> ] [ y>> ] bi / + ] reduce
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ 5/4 ] [
|
|
|
|
[
|
|
|
|
2 malloc-test-struct-array
|
|
|
|
dup &free drop
|
|
|
|
1 2 make-point over set-first
|
|
|
|
3 4 make-point over set-second
|
|
|
|
0 [ [ x>> ] [ y>> ] bi / + ] reduce
|
|
|
|
] with-destructors
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
|
|
|
|
|
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
10 malloc-test-struct-array
|
|
|
|
&free drop
|
|
|
|
] with-destructors
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
|
|
|
|
|
|
|
|
[ S{ test-struct f 12 20 } ] [
|
|
|
|
test-struct-array{
|
|
|
|
S{ test-struct f 4 20 }
|
|
|
|
S{ test-struct f 12 20 }
|
|
|
|
S{ test-struct f 20 20 }
|
|
|
|
} second
|
|
|
|
] unit-test
|
|
|
|
|
2010-04-12 21:29:47 -04:00
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
test-struct specialized-array-vocab forget-vocab
|
|
|
|
] with-compilation-unit
|
|
|
|
] unit-test
|
|
|
|
|
2009-09-09 23:33:34 -04:00
|
|
|
! Regression
|
2009-09-13 01:24:31 -04:00
|
|
|
STRUCT: fixed-string { text char[64] } ;
|
2009-09-09 23:33:34 -04:00
|
|
|
|
|
|
|
SPECIALIZED-ARRAY: fixed-string
|
|
|
|
|
2009-09-13 01:24:31 -04:00
|
|
|
[ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } ] [
|
|
|
|
ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
|
2009-09-09 23:33:34 -04:00
|
|
|
] unit-test
|
2009-09-10 15:46:26 -04:00
|
|
|
|
|
|
|
! Ensure that byte-length works with direct arrays
|
|
|
|
[ 400 ] [
|
|
|
|
ALIEN: 123 100 <direct-int-array> byte-length
|
|
|
|
] unit-test
|
|
|
|
|
2010-04-12 21:29:47 -04:00
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
fixed-string specialized-array-vocab forget-vocab
|
|
|
|
] with-compilation-unit
|
|
|
|
] unit-test
|
|
|
|
|
2009-09-10 15:46:26 -04:00
|
|
|
! 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
|
|
|
|
|
|
|
|
! If the C type doesn't exist, don't generate a vocab
|
2009-10-19 05:41:53 -04:00
|
|
|
SYMBOL: __does_not_exist__
|
|
|
|
|
2009-09-10 15:46:26 -04:00
|
|
|
[
|
2009-09-20 23:42:40 -04:00
|
|
|
"""
|
2009-09-10 15:46:26 -04:00
|
|
|
IN: specialized-arrays.tests
|
|
|
|
USING: specialized-arrays ;
|
|
|
|
|
2009-09-20 23:42:40 -04:00
|
|
|
SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- )
|
2009-09-10 15:46:26 -04:00
|
|
|
] must-fail
|
|
|
|
|
|
|
|
[ ] [
|
2009-09-20 23:42:40 -04:00
|
|
|
"""
|
2009-09-10 15:46:26 -04:00
|
|
|
IN: specialized-arrays.tests
|
2009-09-28 09:48:39 -04:00
|
|
|
USING: alien.c-types classes.struct specialized-arrays ;
|
2009-09-10 15:46:26 -04:00
|
|
|
|
|
|
|
STRUCT: __does_not_exist__ { x int } ;
|
|
|
|
|
|
|
|
SPECIALIZED-ARRAY: __does_not_exist__
|
2009-09-20 23:42:40 -04:00
|
|
|
""" eval( -- )
|
2009-09-10 15:46:26 -04:00
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ f ] [
|
|
|
|
"__does_not_exist__-array{"
|
2009-10-19 05:41:53 -04:00
|
|
|
__does_not_exist__ specialized-array-vocab lookup
|
2009-09-10 15:46:26 -04:00
|
|
|
deferred?
|
|
|
|
] unit-test
|
2009-10-19 05:41:53 -04:00
|
|
|
|
2009-10-20 03:18:28 -04:00
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
\ __does_not_exist__ forget
|
|
|
|
__does_not_exist__ specialized-array-vocab forget-vocab
|
|
|
|
] with-compilation-unit
|
|
|
|
] unit-test
|
2009-11-15 12:26:37 -05:00
|
|
|
|
|
|
|
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-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
|
2010-04-12 21:29:47 -04:00
|
|
|
|
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
struct-resize-test specialized-array-vocab forget-vocab
|
2010-05-02 16:21:56 -04:00
|
|
|
\ struct-resize-test-usage forget
|
2010-04-12 21:29:47 -04:00
|
|
|
] with-compilation-unit
|
|
|
|
] unit-test
|