From 5fda0ed040cdf193efeae89915e0c87a8110ae66 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 14 Apr 2008 03:54:02 -0500
Subject: [PATCH] Throw error if superclass is not a tuple class
---
core/classes/tuple/tuple-tests.factor | 3 +++
core/classes/tuple/tuple.factor | 11 ++++++++++-
core/debugger/debugger.factor | 5 ++++-
3 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 2575570d2f..94172a01ef 100755
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -538,3 +538,6 @@ TUPLE: another-forget-accessors-test ;
] with-string-writer empty?
] with-variable
] unit-test
+
+! Missing error check
+[ "IN: tuples.test USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index aa8ef6cdb7..8c7b5437bd 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -58,6 +58,8 @@ PRIVATE>
: all-slot-names ( class -- slots )
superclasses [ slot-names ] map concat \ class prefix ;
+ERROR: bad-superclass class ;
+
<PRIVATE
: tuple= ( tuple1 tuple2 -- ? )
@@ -185,16 +187,23 @@ M: tuple-class update-class
: tuple-class-unchanged? ( class superclass slots -- ? )
rot tuck [ superclass = ] [ slot-names = ] 2bi* and ;
+: valid-superclass? ( class -- ? )
+ [ tuple-class? ] [ tuple bootstrap-word eq? ] bi or ;
+
+: check-superclass ( superclass -- )
+ dup valid-superclass? [ bad-superclass ] unless drop ;
+
PRIVATE>
GENERIC# define-tuple-class 2 ( class superclass slots -- )
M: word define-tuple-class
+ over check-superclass
define-new-tuple-class ;
M: tuple-class define-tuple-class
3dup tuple-class-unchanged?
- [ 3dup redefine-tuple-class ] unless
+ [ over check-superclass 3dup redefine-tuple-class ] unless
3drop ;
: define-error-class ( class superclass slots -- )
diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor
index dea1904e92..827a5c4e8d 100755
--- a/core/debugger/debugger.factor
+++ b/core/debugger/debugger.factor
@@ -215,7 +215,10 @@ M: check-method summary
drop "Invalid parameters for create-method" ;
M: no-tuple-class summary
- drop "Invalid class for define-constructor" ;
+ drop "BOA constructors can only be defined for tuple classes" ;
+
+M: bad-superclass summary
+ drop "Tuple classes can only inherit from other tuple classes" ;
M: no-cond summary
drop "Fall-through in cond" ;