steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use struct class in struct-arrays test

db4
Joe Groff 2009-08-26 17:38:33 -05:00
parent 24c2eaae01
commit 469e4b526f
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/struct-arrays/struct-arrays-tests.factor
View File

@ -1,40 +1,40 @@
IN: struct-arrays.tests IN: struct-arrays.tests
USING: struct-arrays tools.test kernel math sequences USING: classes.struct struct-arrays tools.test kernel math sequences
alien.syntax alien.c-types destructors libc accessors sequences.private ; alien.syntax alien.c-types destructors libc accessors sequences.private ;
C-STRUCT: test-struct STRUCT: test-struct-array
{ "int" "x" } { x int }
{ "int" "y" } ; { y int } ;
: make-point ( x y -- struct ) : make-point ( x y -- struct )
"test-struct" <c-object> test-struct-array <struct-boa> ;
[ set-test-struct-y ] keep
[ set-test-struct-x ] keep ;
[ 5/4 ] [ [ 5/4 ] [
2 "test-struct" <struct-array> 2 test-struct-array <struct-array>
1 2 make-point over set-first 1 2 make-point over set-first
3 4 make-point over set-second 3 4 make-point over set-second
0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce 0 [ [ x>> ] [ y>> ] bi / + ] reduce
] unit-test ] unit-test
[ 5/4 ] [ [ 5/4 ] [
[ [
2 "test-struct" malloc-struct-array 2 test-struct-array malloc-struct-array
dup &free drop dup &free drop
1 2 make-point over set-first 1 2 make-point over set-first
3 4 make-point over set-second 3 4 make-point over set-second
0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce 0 [ [ x>> ] [ y>> ] bi / + ] reduce
] with-destructors ] with-destructors
] unit-test ] unit-test
[ ] [ ALIEN: 123 10 "test-struct" <direct-struct-array> drop ] unit-test [ ] [ ALIEN: 123 10 test-struct-array <direct-struct-array> drop ] unit-test
[ ] [ [ ] [
[ [
10 "test-struct" malloc-struct-array 10 test-struct-array malloc-struct-array
&free drop &free drop
] with-destructors ] with-destructors
] unit-test ] unit-test
[ 15 ] [ 15 10 "test-struct" <struct-array> resize length ] unit-test [ 15 ] [ 15 10 test-struct-array <struct-array> resize length ] unit-test