Fix setters for value struct slots and add unit test for this case; this fixes an io.mmap regression on Windows

db4
U-SLAVA-DFB8FF805\Slava 2009-01-28 01:58:57 -06:00
parent 5af6c10eed
commit a4a6885189
4 changed files with 40 additions and 15 deletions

2
basis/alien/arrays/arrays.factor Normal file → Executable file
View File

@ -26,7 +26,7 @@ M: array box-return drop "void*" box-return ;
M: array stack-size drop "void*" stack-size ;
M: array c-type-boxer-quot drop f ;
M: array c-type-boxer-quot drop [ ] ;
M: array c-type-unboxer-quot drop [ >c-ptr ] ;

26
basis/alien/c-types/c-types.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces make parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations fry call ;
accessors combinators effects continuations fry call classes ;
IN: alien.c-types
DEFER: <int>
@ -13,18 +13,20 @@ DEFER: *char
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
TUPLE: c-type
class
boxer boxer-quot unboxer unboxer-quot
getter setter
reg-class size align stack-align? ;
: new-c-type ( class -- type )
new
int-regs >>reg-class
object >>class ; inline
{ class class initial: object }
boxer
{ boxer-quot callable }
unboxer
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
{ reg-class initial: int-regs }
size
align
stack-align? ;
: <c-type> ( -- type )
\ c-type new-c-type ;
\ c-type new ;
SYMBOL: c-types
@ -224,7 +226,7 @@ M: f byte-length drop 0 ;
TUPLE: long-long-type < c-type ;
: <long-long-type> ( -- type )
long-long-type new-c-type ;
long-long-type new ;
M: long-long-type unbox-parameter ( n type -- )
c-type-unboxer %unbox-long-long ;

15
basis/alien/structs/structs-tests.factor Normal file → Executable file
View File

@ -42,3 +42,18 @@ C-UNION: barx
[ ] [ \ foox-x "help" get execute ] unit-test
[ ] [ \ set-foox-x "help" get execute ] unit-test
] when
C-STRUCT: nested
{ "int" "x" } ;
C-STRUCT: nested-2
{ "nested" "y" } ;
[ 4 ] [
"nested-2" <c-object>
"nested" <c-object>
4 over set-nested-x
over set-nested-2-y
nested-2-y
nested-x
] unit-test

12
basis/alien/structs/structs.factor Normal file → Executable file
View File

@ -2,10 +2,18 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs generic hashtables kernel kernel.private
math namespaces parser sequences strings words libc fry
alien.c-types alien.structs.fields cpu.architecture math.order ;
alien.c-types alien.structs.fields cpu.architecture math.order
quotations ;
IN: alien.structs
TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
TUPLE: struct-type
size
align
fields
{ boxer-quot callable }
{ unboxer-quot callable }
{ getter callable }
{ setter callable } ;
M: struct-type heap-size size>> ;