steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changing a method into a generated slot accessor would result in the generated accessor being forgotten

db4
Slava Pestov 2009-03-06 20:02:31 -06:00
parent 92c477f1e2
commit bf663e830a
3 changed files with 51 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/delegate/delegate-tests.factor
View File

@ -125,7 +125,7 @@ PROTOCOL: silly-protocol do-me ;
DEFER: slot-protocol-test-3
SLOT: y
[ f ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test
[ f ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test
[ [ ] ] [
<" IN: delegate.tests
@ -135,7 +135,7 @@ CONSULT: y>> slot-protocol-test-3 x>> ;">
<string-reader> "delegate-test-1" parse-stream
] unit-test
[ t ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test
[ t ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test
[ [ ] ] [
<" IN: delegate.tests
@ -143,4 +143,16 @@ TUPLE: slot-protocol-test-3 x y ;">
<string-reader> "delegate-test-1" parse-stream
] unit-test
[ t ] [ \ y>> \ slot-protocol-test-3 method >boolean ] unit-test
! We now have a real accessor for the y slot; we don't want it to
! get lost
[ t ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test
! We want to be able to override methods after consultation
[ [ ] ] [
<" IN: delegate.tests
USING: delegate kernel sequences delegate.protocols accessors ;
TUPLE: override-method-test seq ;
CONSULT: sequence-protocol override-method-test seq>> ;
M: override-method-test like drop ; ">
<string-reader> "delegate-test-2" parse-stream
] unit-test

28
core/classes/tuple/tuple-tests.factor
View File

@ -703,3 +703,31 @@ TUPLE: bogus-hashcode-2 x ;
M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ;
[ ] [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test
DEFER: change-slot-test
SLOT: kex
[ ] [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
[ ] [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
[ ] [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
[ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test
[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test

12
core/parser/parser.factor
View File

@ -220,10 +220,14 @@ print-use-hook [ [ ] ] initialize
"quiet" get [ drop ] [ "Loading " write print flush ] if ;
: filter-moved ( assoc1 assoc2 -- seq )
swap assoc-diff [
drop where dup [ first ] when
file get path>> =
] assoc-filter keys ;
swap assoc-diff keys [
{
{ [ dup where dup [ first ] when file get path>> = not ] [ f ] }
{ [ dup "reading" word-prop ] [ f ] }
{ [ dup "writing" word-prop ] [ f ] }
[ t ]
} cond nip
] filter ;
: removed-definitions ( -- assoc1 assoc2 )
new-definitions old-definitions