From 47c91e379ea25f30d1b8261f0be5979d6ad0aa7e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Mar 2008 05:03:04 -0500
Subject: [PATCH] Fix predicate clobberage

---
 core/classes/tuple/tuple-tests.factor | 13 +++++++++++++
 core/classes/tuple/tuple.factor       |  5 ++---
 2 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 2e37655f1d..9b8228155b 100755
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -340,6 +340,19 @@ TUPLE: electronic-device ;
 [ f ] [ "laptop" get electronic-device? ] unit-test
 [ t ] [ "laptop" get computer? ] unit-test
 
+! Redefinition problem
+TUPLE: redefinition-problem ;
+
+UNION: redefinition-problem' redefinition-problem integer ;
+
+[ t ] [ 3 redefinition-problem'? ] unit-test
+
+TUPLE: redefinition-problem-2 ;
+
+"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval
+
+[ t ] [ 3 redefinition-problem'? ] unit-test
+
 ! Hardcore unit tests
 USE: threads
 
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 28dbfdb372..a452d0eeec 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -140,12 +140,11 @@ PRIVATE>
     [ drop f tuple-class define-class ]
     [ nip define-tuple-slots ] [
         2drop
-        class-usages [
-            drop
+        class-usages keys [ tuple-class? ] subset [
             [ define-tuple-layout ]
             [ define-tuple-predicate ]
             bi
-        ] assoc-each
+        ] each
     ] 3tri ;
 
 : redefine-tuple-class ( class superclass slots -- )