diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 79018f577b..54dbc8dcaf 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -8,7 +8,7 @@ destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math mirrors namespaces prettyprint prettyprint.config see sequences specialized-arrays system tools.test parser lexer eval layouts generic.single classes -vocabs ; +vocabs generic ; FROM: math => float ; FROM: specialized-arrays.private => specialized-array-vocab ; QUALIFIED-WITH: alien.c-types c @@ -534,3 +534,13 @@ IN: classes.struct.tests STRUCT: struct-1-union { a int initial: 0 } ; " ] [ \ 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 + diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index adb9f330d4..db26f4d209 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -8,7 +8,8 @@ combinators combinators.smart cpu.architecture fry functors.backend generalizations generic.parser kernel kernel.private lexer libc locals macros math math.order parser 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 ; QUALIFIED: math IN: classes.struct @@ -194,6 +195,9 @@ M: struct-c-type base-type ; [ \ struct-slot-values ] [ struct-slot-values-quot ] bi define-inline-method ; +: forget-struct-slot-values-method ( class -- ) + \ struct-slot-values method forget ; + : clone-underlying ( struct -- byte-array ) binary-object memory>byte-array ; inline @@ -202,6 +206,9 @@ M: struct-c-type base-type ; [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi define-inline-method ; +: forget-clone-method ( class -- ) + \ clone method forget ; + :: c-type-for-class ( class slots size align -- c-type ) struct-c-type new byte-array >>class @@ -314,6 +321,14 @@ ERROR: invalid-struct-slot token ; c-type c-type-boxed-class 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: