From 15f36f18734d93108382ae30a604ae5afe581259 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 19 Jan 2012 13:19:32 -0600
Subject: [PATCH] fix a bug in check syntax where it would attempt to (as part
 of the coloring for blame assignment in check syntax) try to color the
 right-hand side of a binding that actually comes from a lambda-bound variable
 (and thus crash for not finding the right-hand side) (cherry picked from
 commit c9e4c88b7ca694b48f0c10007a71fefc2afd3452)

---
 .../private/syncheck/contract-traversal.rkt   |  4 +--
 collects/tests/drracket/syncheck-test.rkt     | 25 ++++++++++++++++++-
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/collects/drracket/private/syncheck/contract-traversal.rkt b/collects/drracket/private/syncheck/contract-traversal.rkt
index 34e8bee9e0..13b6a4e462 100644
--- a/collects/drracket/private/syncheck/contract-traversal.rkt
+++ b/collects/drracket/private/syncheck/contract-traversal.rkt
@@ -122,9 +122,9 @@
                   (if binders
                       (begin
                         (base-color #'id polarity boundary-contract? my-coloring-plans client-coloring-plans)
-                        (for ((binder (in-list (module-identifier-mapping-get low-binders #'id))))
+                        (for ((binder (in-list binders)))
                           (base-color binder polarity boundary-contract? my-coloring-plans client-coloring-plans)
-                          (for ((rhs (in-list (module-identifier-mapping-get binding-inits binder))))
+                          (for ((rhs (in-list (module-identifier-mapping-get binding-inits binder (λ () '())))))
                             (ploop rhs polarity))))
                       (call-give-up))))]
            [const
diff --git a/collects/tests/drracket/syncheck-test.rkt b/collects/tests/drracket/syncheck-test.rkt
index 3ba8ae0eeb..e821d1f4b8 100644
--- a/collects/tests/drracket/syncheck-test.rkt
+++ b/collects/tests/drracket/syncheck-test.rkt
@@ -373,7 +373,6 @@ trigger runtime errors in check syntax.
                 (list '((10 18) (20 38) (51 64))
                       '((39 48) (68 71))))
 
-
      (build-test "(define-for-syntax (f x) x) (define (f x) x) f (define-syntax (m x) (f x))"
                  '(("(" default-color)
                    ("define-for-syntax" imported)
@@ -901,6 +900,30 @@ trigger runtime errors in check syntax.
                        '((52 58) (93 99))
                        '((100 101) (105 106))))
      
+     (build-test "#lang racket (provide (contract-out [f (->i ((p? any/c)) (_ (p?) p?))])) (define (f a) 1)"
+                 '(("#lang racket (" default-color)
+                   ("provide" imported)
+                   (" (contract-out [" default-color)
+                   ("f" lexically-bound)
+                   (" (" default-color)
+                   ("->i" imported)
+                   (" ((p? " default-color)
+                   ("any/c" imported)
+                   (")) (_ (" default-color)
+                   ("p?" lexically-bound)
+                   (") " default-color)
+                   ("p?" lexically-bound)
+                   ("))])) (" default-color)
+                   ("define" imported)
+                   (" (" default-color)
+                   ("f" lexically-bound)
+                   (" " default-color)
+                   ("a" lexically-bound)
+                   (") 1)" default-color))
+                 (list '((82 83) (37 38))
+                       '((61 63) (65 67))
+                       '((6 12) (14 21) (40 43) (49 54) (74 80))))
+
      (rename-test "(lambda (x) x)"
                   9
                   "x"