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
|
||||
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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue