From 5470899d6e6eecf7834caf17324d416b32131221 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Sat, 1 Dec 2012 02:17:32 -0500
Subject: [PATCH] fix shadowing (caused unwanted state threading)   closes PR
 13327

---
 collects/syntax/parse/private/parse.rkt | 38 ++++++++++++-------------
 collects/tests/stxparse/test.rkt        |  5 ++++
 2 files changed, 24 insertions(+), 19 deletions(-)

diff --git a/collects/syntax/parse/private/parse.rkt b/collects/syntax/parse/private/parse.rkt
index 9f00d35004..6f233efa3f 100644
--- a/collects/syntax/parse/private/parse.rkt
+++ b/collects/syntax/parse/private/parse.rkt
@@ -537,16 +537,16 @@ Conventions:
             (if (vector? datum)
                 (let ([datum (vector->list datum)]
                       [vcx (if (syntax? x) x cx)] ;; FIXME: (vector? datum) => (syntax? x) ???
-                      [pr (ps-add-unvector pr)])
-                  (parse:S datum vcx subpattern pr es k))
+                      [pr* (ps-add-unvector pr)])
+                  (parse:S datum vcx subpattern pr* es k))
                 (fail (failure pr es))))]
        [#s(pat:box _attrs subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
             (if (box? datum)
                 (let ([datum (unbox datum)]
                       [bcx (if (syntax? x) x cx)] ;; FIXME: (box? datum) => (syntax? x) ???
-                      [pr (ps-add-unbox pr)])
-                  (parse:S datum bcx subpattern pr es k))
+                      [pr* (ps-add-unbox pr)])
+                  (parse:S datum bcx subpattern pr* es k))
                 (fail (failure pr es))))]
        [#s(pat:pstruct _attrs key subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
@@ -554,13 +554,13 @@ Conventions:
                   (and xkey (equal? xkey 'key)))
                 (let ([datum (struct->list datum)]
                       [scx (if (syntax? x) x cx)] ;; FIXME: (struct? datum) => (syntax? x) ???
-                      [pr (ps-add-unpstruct pr)])
-                  (parse:S datum scx subpattern pr es k))
+                      [pr* (ps-add-unpstruct pr)])
+                  (parse:S datum scx subpattern pr* es k))
                 (fail (failure pr es))))]
        [#s(pat:describe attrs pattern description transparent? role)
-        #`(let ([es (es-add-thing pr description transparent? role es)]
-                [pr (if 'transparent? pr (ps-add-opaque pr))])
-            (parse:S x cx pattern pr es k))]
+        #`(let ([es* (es-add-thing pr description transparent? role es)]
+                [pr* (if 'transparent? pr (ps-add-opaque pr))])
+            (parse:S x cx pattern pr* es* k))]
        [#s(pat:delimit attrs pattern)
         #`(let ([cp0 cut-prompt])
             (with ([cut-prompt fail-handler])
@@ -574,8 +574,8 @@ Conventions:
                               [fail-handler fh0])
                          k))))]
        [#s(pat:post attrs pattern)
-        #`(let ([pr (ps-add-post pr)])
-            (parse:S x cx pattern pr es k))]
+        #`(let ([pr* (ps-add-post pr)])
+            (parse:S x cx pattern pr* es k))]
        [#s(pat:integrated _attrs name predicate description role)
         (with-syntax ([(name-attr ...)
                        (if (identifier? #'name)
@@ -584,8 +584,8 @@ Conventions:
           #'(let ([x* (datum->syntax cx x cx)])
               (if (predicate x*)
                   (let-attributes (name-attr ...) k)
-                  (let ([es (es-add-thing pr 'description #t role es)])
-                    (fail (failure pr es))))))])]))
+                  (let ([es* (es-add-thing pr 'description #t role es)])
+                    (fail (failure pr es*))))))])]))
 
 ;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
 (define-syntax (disjunct stx)
@@ -636,8 +636,8 @@ Conventions:
        [#s(action:do _ (stmt ...))
         #'(let () (no-shadow stmt) ... (#%expression k))]
        [#s(action:post _ pattern)
-        #'(let ([pr (ps-add-post pr)])
-            (parse:A x cx pattern pr es k))])]))
+        #'(let ([pr* (ps-add-post pr)])
+            (parse:A x cx pattern pr* es k))])]))
 
 ;; (bind/sides clauses k) : expr[Ans]
 ;; In k: attrs(clauses) are bound.
@@ -679,8 +679,8 @@ Conventions:
      (syntax-case #'head ()
        [#s(hpat:describe _ pattern description transparent? role)
         #`(let ([es* (es-add-thing pr description transparent? role es)]
-                [pr (if 'transparent? pr (ps-add-opaque pr))])
-            (parse:H x cx rest-x rest-cx rest-pr pattern pr es*
+                [pr* (if 'transparent? pr (ps-add-opaque pr))])
+            (parse:H x cx rest-x rest-cx rest-pr pattern pr* es*
                      (let ([rest-pr (if 'transparent? rest-pr (ps-pop-opaque rest-pr))])
                        k)))]
        [#s(hpat:var _attrs name parser argu (nested-a ...) attr-count commit? role)
@@ -921,8 +921,8 @@ Conventions:
          [_  #`(parse:H x cx x* cx* pr* head pr es
                         (if (< rep (rep:max-number repc))
                             (let ([rep (add1 rep)]) k*)
-                            (let ([es (expectation-of-reps/too-many es rep repc)])
-                              (fail (failure pr* es)))))]))]))
+                            (let ([es* (expectation-of-reps/too-many es rep repc)])
+                              (fail (failure pr* es*)))))]))]))
 
 ;; (rep:initial-value RepConstraint) : expr
 (define-syntax (rep:initial-value stx)
diff --git a/collects/tests/stxparse/test.rkt b/collects/tests/stxparse/test.rkt
index 2aeecb5fa2..e195005b63 100644
--- a/collects/tests/stxparse/test.rkt
+++ b/collects/tests/stxparse/test.rkt
@@ -470,3 +470,8 @@
   ;; test that it works on proper lists w/ embedded stxpairs
   (check-eq? (syntax-parse #'(a b . (c  d)) [(x:id ...) #t] [_ #f]) #t)
   (check-eq? (syntax-parse #'(a b . (c  d)) [(_ x:id ...) #t] [_ #f]) #t))
+
+;; from Eric Dobson (11/30/2012)
+(terx (x y) ((~describe #:opaque "an X" x:id) n:number)
+      #rx"expected number"
+      (not #rx"expected an X"))