diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 3aa225b1f5..960855b191 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -833,3 +833,7 @@ DEFER: initial-slot [ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: 3 } ;" eval( -- ) ] [ error>> T{ bad-initial-value f "x" 3 initial-class } = ] must-fail-with + +[ "IN: classes.tuple.tests USE: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with + +[ "IN: classes.tuple.tests USE: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index c0455a5962..b338769706 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -93,7 +93,7 @@ ERROR: bad-superclass class ; ] [ 2drop f ] if ] [ 2drop f ] if ; inline -GENERIC: final-class? ( class -- ? ) +GENERIC: final-class? ( object -- ? ) M: tuple-class final-class? "final" word-prop ; @@ -101,6 +101,8 @@ M: builtin-class final-class? tuple eq? not ; M: class final-class? drop t ; +M: object final-class? drop f ; + <PRIVATE : tuple-predicate-quot/1 ( class -- quot ) @@ -247,7 +249,8 @@ M: tuple-class update-class bi-curry* bi and ; : check-superclass ( superclass -- ) - dup final-class? [ bad-superclass ] when drop ; + dup final-class? [ bad-superclass ] when + dup class? [ bad-superclass ] unless drop ; GENERIC# (define-tuple-class) 2 ( class superclass slots -- )