diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index a269fad556..b89abdfd82 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -683,3 +683,17 @@ DEFER: error-y [ t ] [ \ error-y tuple-class? ] unit-test [ f ] [ \ error-y generic? ] unit-test + +[ ] [ + "IN: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;" + <string-reader> "forget-subclass-test" parse-stream + drop +] unit-test + +[ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup new "bad-object" set ] unit-test + +[ ] [ + "IN: classes.tuple.tests TUPLE: forget-subclass-test a ;" + <string-reader> "forget-subclass-test" parse-stream + drop +] unit-test diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 8471aa918a..6cf6a9897a 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -194,13 +194,17 @@ ERROR: bad-superclass class ; [ permute-slots ] [ class>> ] bi slots>tuple ; +: outdated-tuple? ( tuple assoc -- ? ) + over tuple? [ + [ [ layout-of ] dip key? ] + [ drop class "forgotten" word-prop not ] + 2bi and + ] [ 2drop f ] if ; + : update-tuples ( -- ) outdated-tuples get dup assoc-empty? [ drop ] [ - [ - over tuple? - [ >r layout-of r> key? ] [ 2drop f ] if - ] curry instances + [ outdated-tuple? ] curry instances dup [ update-tuple ] map become ] if ;