From 1221fb7d555868f4b526751e68a88389c617a955 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 6 Feb 2009 02:43:21 -0600
Subject: [PATCH] delegate: fix problem if source file was reloaded and a
 hand-written method definition was replaced by a consultation; also associate
 consultation-generated methods with the source file they're in

---
 basis/delegate/delegate-tests.factor | 31 +++++++++++++++++++++++++++-
 basis/delegate/delegate.factor       |  4 ++--
 2 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor
index 9095f43211..2651a44f32 100644
--- a/basis/delegate/delegate-tests.factor
+++ b/basis/delegate/delegate-tests.factor
@@ -1,6 +1,6 @@
 USING: delegate kernel arrays tools.test words math definitions
 compiler.units parser generic prettyprint io.streams.string
-accessors eval ;
+accessors eval multiline ;
 IN: delegate.tests
 
 TUPLE: hello this that ;
@@ -91,3 +91,32 @@ CONSULT: slot-protocol-test-2 slot-protocol-test-3 d>> ;
     T{ slot-protocol-test-3 f T{ slot-protocol-test-2 f "a" "b" 5 } }
     [ a>> ] [ b>> ] [ c>> ] tri
 ] unit-test
+
+GENERIC: do-me ( x -- )
+
+M: f do-me drop ;
+
+[ ] [ f do-me ] unit-test
+
+TUPLE: a-tuple ;
+
+PROTOCOL: silly-protocol do-me ;
+
+! Replacing a method definition with a consultation would cause problems
+[ [ ] ] [
+    <" IN: delegate.tests
+    USE: kernel
+
+    M: a-tuple do-me drop ; "> <string-reader> "delegate-test" parse-stream
+] unit-test
+
+[ ] [ T{ a-tuple } do-me ] unit-test
+
+[ [ ] ] [
+    <" IN: delegate.tests
+    USE: kernel
+    USE: delegate
+    CONSULT: silly-protocol a-tuple drop f ; "> <string-reader> "delegate-test" parse-stream
+] unit-test
+
+[ ] [ T{ a-tuple } do-me ] unit-test
\ No newline at end of file
diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor
index 2dde4bf8e4..c88c99384f 100644
--- a/basis/delegate/delegate.factor
+++ b/basis/delegate/delegate.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes.tuple definitions
 generalizations generic hashtables kernel lexer make math parser
-sequences sets slots words words.symbol fry ;
+generic.parser sequences sets slots words words.symbol fry ;
 IN: delegate
 
 : protocol-words ( protocol -- words )
@@ -24,7 +24,7 @@ M: tuple-class group-words
 ! Consultation
 
 : consult-method ( word class quot -- )
-    [ drop swap first create-method ]
+    [ drop swap first create-method-in ]
     [ nip [ , dup second , \ ndip , first , ] [ ] make ] 3bi
     define ;