From 0502e537d7d83e344d258e13e94f7a68b920b3da Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 26 Mar 2019 15:53:02 +0100
Subject: [PATCH] syntax/parse: update fix #1452

- Propagate disappeared uses from any pattern stx, not only those
  attached to forms that themselves have a disappearing use.
- Fix for new local-apply-transformer handling of scopes.
---
 .../stxparse/manual/disappeared-uses.rkt      | 26 +++++++++++++++++++
 racket/collects/syntax/parse/private/rep.rkt  | 10 ++++---
 2 files changed, 32 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/racket-test/tests/stxparse/manual/disappeared-uses.rkt

diff --git a/pkgs/racket-test/tests/stxparse/manual/disappeared-uses.rkt b/pkgs/racket-test/tests/stxparse/manual/disappeared-uses.rkt
new file mode 100644
index 0000000000..a51d9c645f
--- /dev/null
+++ b/pkgs/racket-test/tests/stxparse/manual/disappeared-uses.rkt
@@ -0,0 +1,26 @@
+#lang racket/base
+(require (for-syntax racket/base syntax/parse))
+
+(begin-for-syntax
+  (require (for-syntax racket/base))
+  (define-syntax => #f)  ;; DEF
+  (define-syntax ~thing
+    (pattern-expander
+     (lambda (stx)
+       (syntax-case stx (=>)
+         [(_ p1 => p2)
+          (with-syntax ([dots (quote-syntax ...)])
+            (syntax-property
+             #'((~and p1 ~!) dots . p2)
+             'disappeared-use
+             (syntax-local-introduce (caddr (syntax->list stx)))))])))))
+
+(define-syntax (mac stx)
+  (syntax-parse stx
+    [(_ (~thing x:id => rest))  ;; USE
+     #'(quote ((x ...) rest))]))
+
+(void (mac (a b 3)))
+
+;; Check Syntax should draw an arrow between the occurrence of `=>`
+;; marked USE and the occurrence of `=>` marked DEF.
diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt
index c4bc935485..527467b472 100644
--- a/racket/collects/syntax/parse/private/rep.rkt
+++ b/racket/collects/syntax/parse/private/rep.rkt
@@ -168,18 +168,18 @@
 
 (define (disappeared! x)
   (cond [(identifier? x)
-         (when (syntax-property x 'disappeared-uses)
-           (record-disappeared-uses (syntax-property x 'disappeared-uses)))
          (record-disappeared-uses (list x))]
         [(and (stx-pair? x) (identifier? (stx-car x)))
-         (when (syntax-property (stx-car x) 'disappeared-uses)
-           (record-disappeared-uses (syntax-property (stx-car x) 'disappeared-uses)))
          (record-disappeared-uses (list (stx-car x)))]
         [else
          (raise-type-error 'disappeared!
                            "identifier or syntax with leading identifier"
                            x)]))
 
+(define (propagate-disappeared! stx)
+  (cond [(and (syntax? stx) (syntax-property stx 'disappeared-use))
+         => (lambda (xs) (record-disappeared-uses (filter identifier? (flatten xs)) #f))]))
+
 ;; ---
 
 ;; parse-rhs : Syntax Boolean #:context Syntax #:default-description (U String #f) -> RHS
@@ -451,6 +451,7 @@
           [else
            (wrong-syntax stx "action pattern not allowed here")]))
   (define not-shadowed? (make-not-shadowed? decls))
+  (propagate-disappeared! stx)
   (check-pattern
   (syntax-case* stx (~var ~literal ~datum ~and ~or ~or* ~alt ~not ~rest ~describe
                      ~seq ~optional ~! ~bind ~fail ~parse ~do ~undo
@@ -626,6 +627,7 @@
     (unless (stx-list? stx) (wrong-syntax stx "expected sequence of patterns"))
     (apply append (map recur (cdr (stx->list stx)))))
   (define not-shadowed? (make-not-shadowed? decls))
+  (propagate-disappeared! stx)
   (syntax-case* stx (~eh-var ~or ~alt ~between ~optional ~once)
                 (make-not-shadowed-id=? decls)
     [id