From 8f0530daa6f8ce5a71dbea6f9edf081229301dc8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 31 Mar 2008 03:40:27 -0500
Subject: [PATCH] More inheritance fixes
---
core/classes/tuple/tuple-tests.factor | 44 ++++++++++++++++++++++++++-
core/classes/tuple/tuple.factor | 15 +++++----
2 files changed, 50 insertions(+), 9 deletions(-)
diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 950650dbf0..db0e25f091 100755
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -3,7 +3,7 @@ math.constants parser sequences tools.test words assocs
namespaces quotations sequences.private classes continuations
generic.standard effects classes.tuple classes.tuple.private
arrays vectors strings compiler.units accessors classes.algebra
-calendar prettyprint io.streams.string splitting ;
+calendar prettyprint io.streams.string splitting inspector ;
IN: classes.tuple.tests
TUPLE: rect x y w h ;
@@ -418,6 +418,48 @@ test-a/b
test-a/b
+! Moving slots up and down
+TUPLE: move-up-1 a b ;
+TUPLE: move-up-2 < move-up-1 c ;
+
+T{ move-up-2 f "a" "b" "c" } "move-up" set
+
+: test-move-up
+ [ "a" ] [ "move-up" get a>> ] unit-test
+ [ "b" ] [ "move-up" get b>> ] unit-test
+ [ "c" ] [ "move-up" get c>> ] unit-test ;
+
+test-move-up
+
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval ] unit-test
+
+test-move-up
+
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval ] unit-test
+
+test-move-up
+
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval ] unit-test
+
+test-move-up
+
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval ] unit-test
+
+! Constructors must be recompiled when changing superclass
+TUPLE: constructor-update-1 xxx ;
+
+TUPLE: constructor-update-2 < constructor-update-1 yyy zzz ;
+
+C: <constructor-update-2> constructor-update-2
+
+{ 3 1 } [ <constructor-update-2> ] must-infer-as
+
+[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval ] unit-test
+
+{ 5 1 } [ <constructor-update-2> ] must-infer-as
+
+[ { f 1 2 3 4 5 } ] [ 1 2 3 4 5 <constructor-update-2> tuple-slots ] unit-test
+
! Redefinition problem
TUPLE: redefinition-problem ;
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 158ea9fc55..a3d0238d1c 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -184,15 +184,14 @@ PRIVATE>
: redefine-tuple-class ( class superclass slots -- )
[
2drop
- [ update-tuples-after ] each-subclass
- ]
- [
- nip
- [ forget-removed-slots ]
- [ drop changed-word ]
- [ drop redefined ]
- 2tri
+ [
+ [ update-tuples-after ]
+ [ changed-word ]
+ [ redefined ]
+ tri
+ ] each-subclass
]
+ [ nip forget-removed-slots ]
[ define-new-tuple-class ]
3tri ;