Changing a method into a generated slot accessor would result in the generated access...

diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor
index 4b024077354d29a24eae100d68ee9050e8eb6502..ff55fb128268dbd12b6221124ad6a50b0c37b79c 100644 (file)
--- a/basis/delegate/delegate-tests.factor
+++ b/basis/delegate/delegate-tests.factor
@@ -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
\ No newline at end of file
+! 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
\ No newline at end of file

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 8d2610ccd7ffce1d9cbe2a74872f5008e8a268e0..d221d28da94bd70c2f73d46a5038d079f38cef0a 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -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
\ No newline at end of file

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index e39422945ee51cb5710a4ffcc19fc6b5d92f4a20..9e578120f4395be7a27383c020d989caa391981e 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -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