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

Define reset-class for struct-classes, add unit tests. Fixes #206.

db4
Doug Coleman 2011-10-02 20:06:44 -07:00
parent 447466bf45
commit c4418e637e
2 changed files with 27 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/classes/struct/struct-tests.factor
View File

@ -8,7 +8,7 @@ destructors io.encodings.utf8 io.pathnames io.streams.string
kernel libc literals math mirrors namespaces prettyprint kernel libc literals math mirrors namespaces prettyprint
prettyprint.config see sequences specialized-arrays system prettyprint.config see sequences specialized-arrays system
tools.test parser lexer eval layouts generic.single classes tools.test parser lexer eval layouts generic.single classes
vocabs ; vocabs generic ;
FROM: math => float ; FROM: math => float ;
FROM: specialized-arrays.private => specialized-array-vocab ; FROM: specialized-arrays.private => specialized-array-vocab ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
@ -534,3 +534,13 @@ IN: classes.struct.tests
STRUCT: struct-1-union { a int initial: 0 } ; STRUCT: struct-1-union { a int initial: 0 } ;
" ] " ]
[ \ struct-1-union [ see ] with-string-writer ] unit-test [ \ struct-1-union [ see ] with-string-writer ] unit-test
! Bug #206
STRUCT: going-to-forget { a uint } ;
[ ] [
"IN: classes.struct.tests TUPLE: going-to-forget b ;" eval( -- )
] unit-test
[ f ] [ "USE: classes.struct.tests M\\ going-to-forget clone" eval( -- obj ) ] unit-test
[ f ] [ "USE: classes.struct.tests M\\ going-to-forget struct-slot-values" eval( -- obj ) ] unit-test

17
basis/classes/struct/struct.factor
View File

@ -8,7 +8,8 @@ combinators combinators.smart cpu.architecture fry
functors.backend generalizations generic.parser kernel functors.backend generalizations generic.parser kernel
kernel.private lexer libc locals macros math math.order parser kernel.private lexer libc locals macros math math.order parser
quotations sequences slots slots.private specialized-arrays quotations sequences slots slots.private specialized-arrays
stack-checker.dependencies summary vectors vocabs.parser words ; stack-checker.dependencies summary vectors vocabs.parser words
classes.private generic definitions ;
FROM: delegate.private => group-words slot-group-words ; FROM: delegate.private => group-words slot-group-words ;
QUALIFIED: math QUALIFIED: math
IN: classes.struct IN: classes.struct
@ -194,6 +195,9 @@ M: struct-c-type base-type ;
[ \ struct-slot-values ] [ struct-slot-values-quot ] bi [ \ struct-slot-values ] [ struct-slot-values-quot ] bi
define-inline-method ; define-inline-method ;
: forget-struct-slot-values-method ( class -- )
\ struct-slot-values method forget ;
: clone-underlying ( struct -- byte-array ) : clone-underlying ( struct -- byte-array )
binary-object memory>byte-array ; inline binary-object memory>byte-array ; inline
@ -202,6 +206,9 @@ M: struct-c-type base-type ;
[ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
define-inline-method ; define-inline-method ;
: forget-clone-method ( class -- )
\ clone method forget ;
:: c-type-for-class ( class slots size align -- c-type ) :: c-type-for-class ( class slots size align -- c-type )
struct-c-type new struct-c-type new
byte-array >>class byte-array >>class
@ -314,6 +321,14 @@ ERROR: invalid-struct-slot token ;
c-type c-type-boxed-class c-type c-type-boxed-class
dup \ byte-array = [ drop \ c-ptr ] when ; dup \ byte-array = [ drop \ c-ptr ] when ;
M: struct-class reset-class
[ call-next-method ]
[
[ forget-struct-slot-values-method ]
[ forget-clone-method ] bi
]
[ { "c-type" "layout" "struct-size" } reset-props ] tri ;
SYMBOL: bits: SYMBOL: bits:
<PRIVATE <PRIVATE