From 2b07cc34f7f7408119876cc3cd61c61c023b0366 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 4 Jan 2015 15:09:37 -0600
Subject: [PATCH] fix context for instanceof/c

also improve test suite to look for ellipses
(but not when using opt/c)
---
 .../tests/racket/contract/context.rkt         | 23 +++++++++++++++----
 .../collects/racket/private/class-c-old.rkt   |  2 +-
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/context.rkt b/pkgs/racket-test/tests/racket/contract/context.rkt
index f38c5f2e2a..3ffee7bc23 100644
--- a/pkgs/racket-test/tests/racket/contract/context.rkt
+++ b/pkgs/racket-test/tests/racket/contract/context.rkt
@@ -8,7 +8,7 @@
                  'racket/class
                  'racket/contract/private/blame)])
   
-  (contract-eval '(define (extract-context-lines thunk)
+  (contract-eval '(define (extract-context-lines opt/c? thunk)
                     (define str
                       (with-handlers ((exn:fail:contract:blame? exn-message))
                         (thunk)
@@ -30,7 +30,11 @@
                                (cond
                                  [(or (regexp-match #rx"^the " line)
                                       (regexp-match #rx"^an " line)
-                                      (regexp-match #rx"^a " line))
+                                      (regexp-match #rx"^a " line)
+                                      
+                                      ;; opt/c needs to be fixed so it includes
+                                      ;; the right context in the right places
+                                      (and (not opt/c?) (regexp-match #rx"^[.][.][.]$" line)))
                                   (cons line (loop (cdr lines)))]
                                  [else
                                   (loop (cdr lines))])]))]
@@ -51,7 +55,7 @@
     (contract-eval
      #:test-case-name name
      `(,test #:test-case-name ',name
-             ',context extract-context-lines
+             ',context extract-context-lines #f
              (lambda () ,expression)))
     (let/ec k
       (define rewritten (rewrite-to-add-opt/c expression k))
@@ -60,7 +64,7 @@
         (contract-eval 
          #:test-case-name opt-name
          `(,test #:test-case-name ',opt-name
-                 ',context extract-context-lines (lambda () ,rewritten))))))
+                 ',context extract-context-lines #t (lambda () ,rewritten))))))
   
   (context-test '("the 1st argument of")
                 '((contract (-> boolean? integer? integer?)
@@ -476,6 +480,17 @@
                             'pos 'neg)
                   1))
   
+  (context-test '("the range of"
+                  "the save-file method in")
+                '(send (contract (instanceof/c
+                                  (class/c [save-file (-> any/c number?)]))
+                                 (new
+                                  (class object%
+                                    (define/public (save-file) #f)
+                                    (super-new)))
+                                 'pos 'neg)
+                       save-file))
+  
   (let* ([blame-pos (contract-eval '(make-blame (srcloc #f #f #f #f #f)
                                                 #f
                                                 (λ () 'integer?)
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index d7f2838f49..93c09277ff 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -1274,7 +1274,7 @@
 (define (instanceof/c-proj ctc)
   (define proj (contract-projection (base-instanceof/c-class-ctc ctc)))
   (λ (blame)
-    (define p (proj blame))
+    (define p (proj (blame-add-context blame #f)))
     (λ (val)
       (unless (object? val)
         (raise-blame-error blame val '(expected: "an object" given: "~e") val))