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

get classes.struct tests passing

db4
Joe Groff 2009-08-12 10:01:32 -04:00
parent 4896d6b9a3
commit 4461a63e1d
2 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
USING: classes.struct tools.test ; USING: accessors alien.c-types classes.c-types classes.struct
IN: classes.struct.test combinators kernel tools.test ;
IN: classes.struct.tests
STRUCT: foo STRUCT: foo
{ x char } { x char }
@ -14,3 +15,13 @@ STRUCT: bar
[ 16 ] [ bar heap-size ] unit-test [ 16 ] [ bar heap-size ] unit-test
[ 123 ] [ foo new y>> ] unit-test [ 123 ] [ foo new y>> ] unit-test
[ 123 ] [ bar new foo>> y>> ] unit-test [ 123 ] [ bar new foo>> y>> ] unit-test
[ 1 2 3 t ] [
1 2 3 t foo boa bar boa
{
[ w>> ]
[ foo>> x>> ]
[ foo>> y>> ]
[ foo>> z>> ]
} cleave
] unit-test

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

@ -22,7 +22,7 @@ M: struct >c-ptr
: memory>struct ( ptr class -- struct ) : memory>struct ( ptr class -- struct )
over c-ptr? [ swap \ c-ptr bad-slot-value ] unless over c-ptr? [ swap \ c-ptr bad-slot-value ] unless
tuple-layout <tuple-boa> ; inline tuple-layout <tuple> [ 2 set-slot ] keep ;
: malloc-struct ( class -- struct ) : malloc-struct ( class -- struct )
[ heap-size malloc ] keep memory>struct ; inline [ heap-size malloc ] keep memory>struct ; inline
@ -100,7 +100,7 @@ M: struct-class heap-size
: struct-prototype ( class -- prototype ) : struct-prototype ( class -- prototype )
[ heap-size <byte-array> ] [ heap-size <byte-array> ]
[ tuple-layout <tuple> [ 2 set-slot ] keep ] [ memory>struct ]
[ "struct-slots" word-prop ] tri [ "struct-slots" word-prop ] tri
[ [
[ initial>> ] [ initial>> ]
@ -122,7 +122,7 @@ M: struct-class heap-size
: define-struct-class ( class slots -- ) : define-struct-class ( class slots -- )
[ drop struct f define-tuple-class ] [ [ drop struct f define-tuple-class ] [
make-slots dup make-slots dup
[ check-struct-slots ] [ struct-offsets ] [ struct-align ] tri [ check-struct-slots ] [ struct-offsets ] [ struct-align [ align ] keep ] tri
(define-struct-class) (define-struct-class)
] [ drop dup struct-prototype "prototype" set-word-prop ] 2tri ; ] [ drop dup struct-prototype "prototype" set-word-prop ] 2tri ;