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
parent
9b492b55e0
commit
cc94894441
|
@ -1,10 +1,9 @@
|
||||||
USING: alien arrays definitions generic assocs hashtables io
|
USING: alien arrays definitions generic assocs hashtables io
|
||||||
kernel math namespaces parser prettyprint sequences strings
|
io.streams.string kernel math namespaces parser prettyprint
|
||||||
tools.test vectors words quotations classes
|
sequences strings tools.test vectors words quotations classes
|
||||||
classes.private classes.union classes.mixin classes.predicate
|
classes.private classes.union classes.mixin classes.predicate
|
||||||
classes.algebra vectors definitions source-files
|
classes.algebra vectors definitions source-files compiler.units
|
||||||
compiler.units kernel.private sorting vocabs memory eval
|
kernel.private sorting vocabs memory eval accessors ;
|
||||||
accessors ;
|
|
||||||
IN: classes.tests
|
IN: classes.tests
|
||||||
|
|
||||||
[ t ] [ 3 object instance? ] unit-test
|
[ t ] [ 3 object instance? ] unit-test
|
||||||
|
@ -38,3 +37,45 @@ M: method-forget-class method-forget-test ;
|
||||||
[ word? ] instances
|
[ word? ] instances
|
||||||
[ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
|
[ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count
|
||||||
] unit-test
|
] 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
|
||||||
|
|
|
@ -109,10 +109,11 @@ SYMBOL: remake-generics-hook
|
||||||
compiled-generic-crossref get at ;
|
compiled-generic-crossref get at ;
|
||||||
|
|
||||||
: (compiled-generic-usages) ( generic class -- assoc )
|
: (compiled-generic-usages) ( generic class -- assoc )
|
||||||
dup class? [
|
|
||||||
[ compiled-generic-usage ] dip
|
[ compiled-generic-usage ] dip
|
||||||
[ classes-intersect? nip ] curry assoc-filter
|
[
|
||||||
] [ 2drop f ] if ;
|
2dup [ class? ] both?
|
||||||
|
[ classes-intersect? ] [ 2drop f ] if nip
|
||||||
|
] curry assoc-filter ;
|
||||||
|
|
||||||
: compiled-generic-usages ( assoc -- assocs )
|
: compiled-generic-usages ( assoc -- assocs )
|
||||||
[ (compiled-generic-usages) ] { } assoc>map ;
|
[ (compiled-generic-usages) ] { } assoc>map ;
|
||||||
|
|
Loading…
Reference in New Issue