diff --git a/core/classes/predicate/predicate-tests.factor b/core/classes/predicate/predicate-tests.factor index 3de073f774..d4c929a69b 100644 --- a/core/classes/predicate/predicate-tests.factor +++ b/core/classes/predicate/predicate-tests.factor @@ -1,4 +1,4 @@ -USING: math tools.test classes.algebra ; +USING: math tools.test classes.algebra words kernel sequences assocs ; IN: classes.predicate PREDICATE: negative < integer 0 < ; @@ -19,3 +19,9 @@ M: positive abs ; [ 10 ] [ -10 abs ] unit-test [ 10 ] [ 10 abs ] unit-test [ 0 ] [ 0 abs ] unit-test + +PREDICATE: blah < word blah eq? ; + +[ f ] [ \ predicate-instance? "compiled-uses" word-prop keys \ blah swap memq? ] unit-test + +FORGET: blah \ No newline at end of file diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor index 4ba93acae4..7d757772f4 100644 --- a/core/classes/predicate/predicate.factor +++ b/core/classes/predicate/predicate.factor @@ -25,8 +25,9 @@ DEFER: predicate-instance? ( object class -- ? ) : predicate-quot ( class -- quot ) [ \ dup , - dup superclass "predicate" word-prop % - "predicate-definition" word-prop , [ drop f ] , \ if , + [ superclass "predicate" word-prop % ] + [ "predicate-definition" word-prop , ] bi + [ drop f ] , \ if , ] [ ] make ; : define-predicate-class ( class superclass definition -- ) @@ -42,9 +43,8 @@ DEFER: predicate-instance? ( object class -- ? ) update-predicate-instance ; M: predicate-class reset-class - [ call-next-method ] - [ { "predicate-definition" } reset-props ] - bi ; + [ call-next-method ] [ { "predicate-definition" } reset-props ] bi + update-predicate-instance ; M: predicate-class rank-class drop 1 ; diff --git a/core/classes/union/union-tests.factor b/core/classes/union/union-tests.factor index 0802c0a2d9..57b742595f 100644 --- a/core/classes/union/union-tests.factor +++ b/core/classes/union/union-tests.factor @@ -70,10 +70,14 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ; [ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test +[ t ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test + [ ] [ "IN: classes.union.tests USE: math UNION: blah integer ;" "union-reset-test" parse-stream drop ] unit-test [ t ] [ "blah" "classes.union.tests" lookup union-class? ] unit-test +[ f ] [ "foo?" "classes.union.tests" lookup predicate? ] unit-test + GENERIC: test-generic ( x -- y ) TUPLE: a-tuple ;