Fixes #3236: preserve disappeared-use on local, block, and class

racket/collects/racket/block.rkt

@@ -7,7 +7,7 @@
                          "private/cond.rkt"
                          "private/stxcase-scheme.rkt"
                          "private/qqstx.rkt"
-                         syntax/intdef))
+                         "private/intdef-util.rkt"))
 
 (#%provide block)
 
@@ -46,14 +46,24 @@
                       #'rhs def-ctx)
                      (with-syntax ([(id ...) (map syntax-local-identifier-as-binding
                                                   (syntax->list #'(id ...)))])
-                       (loop todo (cons #'(define-syntaxes (id ...) rhs) r))))]
+                       (loop todo (cons (datum->syntax
+                                         expr
+                                         (list #'define-syntaxes #'(id ...) #'rhs)
+                                         expr
+                                         expr)
+                                        r))))]
                   [(define-values (id ...) rhs)
                    (andmap identifier? (syntax->list #'(id ...)))
                    (let ([ids (syntax->list #'(id ...))])
                      (syntax-local-bind-syntaxes ids #f def-ctx)
                      (with-syntax ([(id ...) (map syntax-local-identifier-as-binding
                                                     (syntax->list #'(id ...)))])
-                       (loop todo (cons #'(define-values (id ...) rhs) r))))]
+                       (loop todo (cons (datum->syntax
+                                         expr
+                                         (list #'define-values #'(id ...) #'rhs)
+                                         expr
+                                         expr)
+                                        r))))]
                   [else (loop todo (cons expr r))]))))])
     (internal-definition-context-seal def-ctx)
     (let loop ([exprs exprs]
@@ -62,8 +72,9 @@
                [prev-exprs null])
       (cond
         [(null? exprs)
-         (internal-definition-context-track
+         (add-decl-props
           def-ctx
+          (append prev-stx-defns prev-defns)
           #`(letrec-syntaxes+values
              #,(map stx-cdr (reverse prev-stx-defns))
              #,(map stx-cdr (reverse prev-defns))

racket/collects/racket/private/class-internal.rkt

@@ -20,8 +20,8 @@
                      syntax/flatten-begin
                      syntax/private/boundmap
                      syntax/parse
-                     syntax/intdef
+                     "classidmap.rkt"
-                     "classidmap.rkt"))
+                     "intdef-util.rkt"))
 
 (define insp (current-inspector)) ; for all opaque structures
 
@@ -388,7 +388,7 @@
                        (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #'rhs def-ctx)
                        (with-syntax ([(id ...) (map syntax-local-identifier-as-binding
                                                     (syntax->list #'(id ...)))])
-                         (cons (syntax/loc e (define-syntaxes (id ...) rhs))
+                         (cons (datum->syntax e (list #'define-syntaxes #'(id ...) #'rhs) e e)
                                (loop (cdr l))))))]
                   [(define-values (id ...) rhs)
                    (andmap identifier? (syntax->list #'(id ...)))
@@ -956,30 +956,7 @@
                           [(rename-inners)
                            (flatten pair (extract* (list (quote-syntax -rename-inner)) decls))])
               
-              ;; this function copies properties from the declarations expressions
+
-              ;; that get dropped from a class form (e.g. (public x) from the body
-              ;; of a class). It doesn't use syntax-track-origin because there is
-              ;; no residual code that it would make sense to be the result of expanding
-              ;; those away. So, instead we only look at a few properties (as below).
-              ;; Also, add 'disappeared-binding properties from `ctx`.
-              (define (add-decl-props stx)
-                (internal-definition-context-track
-                 def-ctx
-                 (for/fold ([stx stx])
-                           ([decl (in-list (append inspect-decls decls))])
-                   (define (copy-prop src dest stx)
-                     (syntax-property 
-                      stx
-                      dest
-                      (cons (syntax-property decl src)
-                            (syntax-property stx dest))))
-                   (copy-prop
-                    'origin 'disappeared-use
-                    (copy-prop
-                     'disappeared-use 'disappeared-use
-                     (copy-prop
-                      'disappeared-binding 'disappeared-binding
-                      stx))))))
               ;; At most one inspect:
               (unless (or (null? inspect-decls)
                           (null? (cdr inspect-decls)))
@@ -1536,6 +1513,8 @@
                                           [private-field-names private-field-names])
                               (class-syntax-protect
                               (add-decl-props
+                              def-ctx
+                              (append inspect-decls decls)
                               (quasisyntax/loc stx
                                 (detect-field-unsafe-undefined
                                  compose-class

racket/collects/racket/private/intdef-util.rkt

@@ -0,0 +1,28 @@
+#lang racket/base
+
+(provide add-decl-props)
+(require syntax/intdef)
+
+;; this function copies properties from the declarations expressions
+;; that get dropped. (e.g. (public x) from the body of a class).
+;; It doesn't use syntax-track-origin because there is
+;; no residual code that it would make sense to be the result of expanding
+;; those away. So, instead we only look at a few properties (as below).
+;; Also, add 'disappeared-binding properties from `ctx`.
+(define (add-decl-props def-ctx decls stx)
+  (internal-definition-context-track
+   def-ctx
+   (for/fold ([stx stx]) ([decl (in-list decls)])
+     (define (copy-prop src dest stx)
+       (syntax-property
+        stx
+        dest
+        (cons (syntax-property decl src)
+              (syntax-property stx dest))))
+     (copy-prop
+      'origin 'disappeared-use
+      (copy-prop
+       'disappeared-use 'disappeared-use
+       (copy-prop
+        'disappeared-binding 'disappeared-binding
+        stx))))))

racket/collects/racket/private/local.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require (for-syntax racket/base)
-         (for-syntax syntax/kerncase))
+         (for-syntax syntax/kerncase
+                     "intdef-util.rkt"))
 (provide (for-syntax do-local))
 
 (define-for-syntax (do-local stx combine)
@@ -52,7 +53,7 @@
                                                      'expression
                                                      null)])
                                    (syntax-local-bind-syntaxes ids #'rhs def-ctx)
-                                   (list (quasisyntax/loc d (define-syntaxes #,ids rhs)))))]
+                                   (list (datum->syntax d (list #'define-syntaxes #'(id ...) #'rhs) d d))))]
                               [(define-syntaxes . rest)
                                (raise-syntax-error
                                 #f "ill-formed definition" stx d)]
@@ -97,10 +98,13 @@
                                 stx
                                 'add))
                              (syntax->list #'(body1 body ...)))])
-           (combine def-ctx
+           (add-decl-props
-                    expand-context
+            def-ctx
-                    #'sbindings
+            defs
-                    #'vbindings
+            (combine def-ctx
-                    #'(body ...)))))]
+                     expand-context
+                     #'sbindings
+                     #'vbindings
+                     #'(body ...))))))]
     [(_ x body1 body ...)
      (raise-syntax-error #f "not a definition sequence" stx (syntax x))]))