fix stack effect of ERROR: words that inherit slots from a base class

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 191ec75544a58c1a8e877e575e0a4271b3b22d57..5ab83aa015f9b1012fb5969ec27182b8003d7435 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -729,3 +729,8 @@ DEFER: redefine-tuple-twice
 [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
+
+ERROR: base-error x y ;
+ERROR: derived-error < base-error z ;
+
+[ (( x y z -- * )) ] [ \ derived-error stack-effect ] unit-test

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 0b1cd513b772e6f17c96bc99c2daa11bc428e0e2..ccb4e30c31f4a5ecfb5188e60dd8d44109fbdac0 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -280,16 +280,16 @@ M: tuple-class (define-tuple-class)
     [ 2drop ?define-symbol ] [ redefine-tuple-class ] if ;
 
 : thrower-effect ( slots -- effect )
-    [ dup array? [ first ] when ] map { "*" } <effect> ;
+    [ name>> ] map { "*" } <effect> ;
 
 : define-error-class ( class superclass slots -- )
     [ define-tuple-class ]
     [ 2drop reset-generic ]
     [
+        2drop
         [ dup [ boa throw ] curry ]
-        [ drop ]
-        [ thrower-effect ]
-        tri* define-declared
+        [ all-slots thrower-effect ]
+        bi define-declared
     ] 3tri ;
 
 : boa-effect ( class -- effect )