From cc94894441c876a406212d6c5ad05d4d01637f1a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 4 Nov 2008 03:38:44 -0600
Subject: [PATCH] Fix notorious classes-intersect? bug, or at least one
 manifestation thereof. Turns out that we may temporarily end up with
 forgotten classes in the compiled-generic-crossref table. This is not a
 problem, since subsequently the words that reference forgotten classes will
 presumably be redefined and recompiled, but it does mean that
 (compiled-generic-usage) does need to handle this case

---
 core/classes/classes-tests.factor | 51 ++++++++++++++++++++++++++++---
 core/compiler/units/units.factor  |  9 +++---
 2 files changed, 51 insertions(+), 9 deletions(-)

diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index dd12674cc4..c7900da316 100644
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -1,10 +1,9 @@
 USING: alien arrays definitions generic assocs hashtables io
-kernel math namespaces parser prettyprint sequences strings
-tools.test vectors words quotations classes
+io.streams.string kernel math namespaces parser prettyprint
+sequences strings tools.test vectors words quotations classes
 classes.private classes.union classes.mixin classes.predicate
-classes.algebra vectors definitions source-files
-compiler.units kernel.private sorting vocabs memory eval
-accessors ;
+classes.algebra vectors definitions source-files compiler.units
+kernel.private sorting vocabs memory eval accessors ;
 IN: classes.tests
 
 [ t ] [ 3 object instance? ] unit-test
@@ -38,3 +37,45 @@ M: method-forget-class method-forget-test ;
     [ word? ] instances
     [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
 ] unit-test
+
+! Long-standing problem
+USE: multiline
+
+! So the user has some code...
+[ ] [
+    <" IN: classes.test.a
+    GENERIC: g ( a -- b )
+    TUPLE: x ;
+    M: x g ;
+    TUPLE: z < x ;"> <string-reader>
+    "class-intersect-no-method-a" parse-stream drop
+] unit-test
+
+! Note that q inlines M: x g ;
+[ ] [
+    <" IN: classes.test.b
+    USE: classes.test.a
+    USE: kernel
+    : q ( -- b ) z new g ;"> <string-reader>
+    "class-intersect-no-method-b" parse-stream drop
+] unit-test
+
+! Now, the user removes the z class and adds a method,
+[ ] [
+    <" IN: classes.test.a
+    GENERIC: g ( a -- b )
+    TUPLE: x ;
+    M: x g ;
+    TUPLE: j ;
+    M: j g ;"> <string-reader>
+    "class-intersect-no-method-a" parse-stream drop
+] unit-test
+
+! And changes the definition of q
+[ ] [
+    <" IN: classes.test.b
+    USE: classes.test.a
+    USE: kernel
+    : q ( -- b ) j new g ;"> <string-reader>
+    "class-intersect-no-method-b" parse-stream drop
+] unit-test
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index 973d9b5c00..1b6b934dae 100644
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -109,10 +109,11 @@ SYMBOL: remake-generics-hook
     compiled-generic-crossref get at ;
 
 : (compiled-generic-usages) ( generic class -- assoc )
-    dup class? [
-        [ compiled-generic-usage ] dip
-        [ classes-intersect? nip ] curry assoc-filter
-    ] [ 2drop f ] if ;
+    [ compiled-generic-usage ] dip
+    [
+        2dup [ class? ] both?
+        [ classes-intersect? ] [ 2drop f ] if nip
+    ] curry assoc-filter ;
 
 : compiled-generic-usages ( assoc -- assocs )
     [ (compiled-generic-usages) ] { } assoc>map ;