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

db4
Slava Pestov 2008-11-04 03:38:44 -06:00
parent 9b492b55e0
commit cc94894441
2 changed files with 51 additions and 9 deletions

View File

@ -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

View File

@ -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 ;