Redefining methods didn't always update callers if more than one method on the same generic was redefined in a compilation unit
parent
44815fd981
commit
37bc52afa8
|
@ -1,24 +1,42 @@
|
|||
USING: accessors compiler compiler.units tools.test math parser
|
||||
kernel sequences sequences.private classes.mixin generic
|
||||
definitions arrays words assocs eval ;
|
||||
definitions arrays words assocs eval strings ;
|
||||
IN: compiler.tests
|
||||
|
||||
GENERIC: method-redefine-test ( a -- b )
|
||||
GENERIC: method-redefine-generic-1 ( a -- b )
|
||||
|
||||
M: integer method-redefine-test 3 + ;
|
||||
M: integer method-redefine-generic-1 3 + ;
|
||||
|
||||
: method-redefine-test-1 ( -- b ) 3 method-redefine-test ;
|
||||
: method-redefine-test-1 ( -- b ) 3 method-redefine-generic-1 ;
|
||||
|
||||
[ 6 ] [ method-redefine-test-1 ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-test 4 + ;" eval ] unit-test
|
||||
[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval ] unit-test
|
||||
|
||||
[ 7 ] [ method-redefine-test-1 ] unit-test
|
||||
|
||||
[ ] [ [ fixnum \ method-redefine-test method forget ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ fixnum \ method-redefine-generic-1 method forget ] with-compilation-unit ] unit-test
|
||||
|
||||
[ 6 ] [ method-redefine-test-1 ] unit-test
|
||||
|
||||
GENERIC: method-redefine-generic-2 ( a -- b )
|
||||
|
||||
M: integer method-redefine-generic-2 3 + ;
|
||||
|
||||
: method-redefine-test-2 ( -- b ) 3 method-redefine-generic-2 ;
|
||||
|
||||
[ 6 ] [ method-redefine-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval ] unit-test
|
||||
|
||||
[ 7 ] [ method-redefine-test-2 ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
fixnum string [ \ method-redefine-generic-2 method forget ] bi@
|
||||
] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
! Test ripple-up behavior
|
||||
: hey ( -- ) ;
|
||||
: there ( -- ) hey ;
|
||||
|
|
|
@ -72,14 +72,12 @@ SYMBOL: outdated-tuples
|
|||
SYMBOL: update-tuples-hook
|
||||
SYMBOL: remake-generics-hook
|
||||
|
||||
: index>= ( obj1 obj2 seq -- ? )
|
||||
[ index ] curry bi@ >= ;
|
||||
|
||||
: dependency>= ( how1 how2 -- ? )
|
||||
[
|
||||
{
|
||||
called-dependency
|
||||
flushed-dependency
|
||||
inlined-dependency
|
||||
} index
|
||||
] bi@ >= ;
|
||||
{ called-dependency flushed-dependency inlined-dependency }
|
||||
index>= ;
|
||||
|
||||
: strongest-dependency ( how1 how2 -- how )
|
||||
[ called-dependency or ] bi@ [ dependency>= ] most ;
|
||||
|
|
|
@ -9,13 +9,9 @@ SYMBOL: inlined-dependency
|
|||
SYMBOL: flushed-dependency
|
||||
SYMBOL: called-dependency
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: set-in-unit ( value key assoc -- )
|
||||
[ set-at ] [ no-compilation-unit ] if* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYMBOL: changed-definitions
|
||||
|
||||
: changed-definition ( defspec -- )
|
||||
|
@ -23,14 +19,8 @@ SYMBOL: changed-definitions
|
|||
|
||||
SYMBOL: changed-generics
|
||||
|
||||
: changed-generic ( class generic -- )
|
||||
changed-generics get set-in-unit ;
|
||||
|
||||
SYMBOL: remake-generics
|
||||
|
||||
: remake-generic ( generic -- )
|
||||
dup remake-generics get set-in-unit ;
|
||||
|
||||
SYMBOL: new-classes
|
||||
|
||||
: new-class ( word -- )
|
||||
|
@ -52,11 +42,9 @@ M: object forget* drop ;
|
|||
SYMBOL: forgotten-definitions
|
||||
|
||||
: forgotten-definition ( defspec -- )
|
||||
dup forgotten-definitions get
|
||||
[ no-compilation-unit ] unless*
|
||||
set-at ;
|
||||
dup forgotten-definitions get set-in-unit ;
|
||||
|
||||
: forget ( defspec -- ) dup forgotten-definition forget* ;
|
||||
: forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
|
||||
|
||||
: forget-all ( definitions -- ) [ forget ] each ;
|
||||
|
||||
|
|
|
@ -71,6 +71,13 @@ TUPLE: check-method class generic ;
|
|||
\ check-method boa throw
|
||||
] unless ; inline
|
||||
|
||||
: changed-generic ( class generic -- )
|
||||
changed-generics get
|
||||
[ [ [ class-or ] when* ] change-at ] [ no-compilation-unit ] if* ;
|
||||
|
||||
: remake-generic ( generic -- )
|
||||
dup remake-generics get set-in-unit ;
|
||||
|
||||
: with-methods ( class generic quot -- )
|
||||
[ drop changed-generic ]
|
||||
[ [ "methods" word-prop ] dip call ]
|
||||
|
|
Loading…
Reference in New Issue