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

fix classes.struct structs when used in FFI, add a test

db4
Joe Groff 2009-08-25 11:40:05 -05:00
parent d950e5a5de
commit f430c9a3d5
2 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
extra/classes/struct/struct-tests.factor
View File

@ -1,13 +1,15 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien.c-types alien.structs.fields classes.c-types USING: accessors alien.c-types alien.structs.fields alien.syntax
classes.struct combinators io.streams.string kernel libc literals math classes.c-types classes.struct combinators io.streams.string kernel
multiline namespaces prettyprint prettyprint.config see tools.test ; libc literals math multiline namespaces prettyprint prettyprint.config
see tools.test ;
FROM: classes.c-types => float ;
IN: classes.struct.tests IN: classes.struct.tests
STRUCT: struct-test-foo STRUCT: struct-test-foo
{ x char } { x char }
{ y int initial: 123 } { y int initial: 123 }
{ z boolean } ; { z bool } ;
STRUCT: struct-test-bar STRUCT: struct-test-bar
{ w ushort initial: HEX: ffff } { w ushort initial: HEX: ffff }
@ -32,7 +34,7 @@ STRUCT: struct-test-bar
[ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test [ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
UNION-STRUCT: struct-test-float-and-bits UNION-STRUCT: struct-test-float-and-bits
{ f single-float } { f float }
{ bits uint } ; { bits uint } ;
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@ -65,7 +67,7 @@ STRUCT: struct-test-foo
[ <" USING: classes.c-types classes.struct ; [ <" USING: classes.c-types classes.struct ;
IN: classes.struct.tests IN: classes.struct.tests
UNION-STRUCT: struct-test-float-and-bits UNION-STRUCT: struct-test-float-and-bits
{ f single-float initial: 0.0 } { bits uint initial: 0 } ; { f float initial: 0.0 } { bits uint initial: 0 } ;
"> ] "> ]
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test [ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
@ -73,21 +75,21 @@ UNION-STRUCT: struct-test-float-and-bits
T{ field-spec T{ field-spec
{ name "x" } { name "x" }
{ offset 0 } { offset 0 }
{ type $[ char c-type ] } { type char }
{ reader x>> } { reader x>> }
{ writer (>>x) } { writer (>>x) }
} }
T{ field-spec T{ field-spec
{ name "y" } { name "y" }
{ offset 4 } { offset 4 }
{ type $[ int c-type ] } { type int }
{ reader y>> } { reader y>> }
{ writer (>>y) } { writer (>>y) }
} }
T{ field-spec T{ field-spec
{ name "z" } { name "z" }
{ offset 8 } { offset 8 }
{ type $[ boolean c-type ] } { type bool }
{ reader z>> } { reader z>> }
{ writer (>>z) } { writer (>>z) }
} }
@ -97,16 +99,24 @@ UNION-STRUCT: struct-test-float-and-bits
T{ field-spec T{ field-spec
{ name "f" } { name "f" }
{ offset 0 } { offset 0 }
{ type $[ single-float c-type ] } { type float }
{ reader f>> } { reader f>> }
{ writer (>>f) } { writer (>>f) }
} }
T{ field-spec T{ field-spec
{ name "bits" } { name "bits" }
{ offset 0 } { offset 0 }
{ type $[ uint c-type ] } { type uint }
{ reader bits>> } { reader bits>> }
{ writer (>>bits) } { writer (>>bits) }
} }
} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test } ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
STRUCT: struct-test-ffi-foo
{ x int }
{ y int } ;
LIBRARY: f-cdecl
FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
[ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test

2
extra/classes/struct/struct.factor
View File

@ -96,7 +96,7 @@ M: struct-class writer-quot
field-spec new swap { field-spec new swap {
[ name>> >>name ] [ name>> >>name ]
[ offset>> >>offset ] [ offset>> >>offset ]
[ class>> c-type >>type ] [ class>> >>type ]
[ name>> reader-word >>reader ] [ name>> reader-word >>reader ]
[ name>> writer-word >>writer ] [ name>> writer-word >>writer ]
} cleave ; } cleave ;