From f28e8a02d05db4fcf2f74a17e2883f563aad01fb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 3 Aug 2012 14:45:02 -0600 Subject: [PATCH] fix 'disappeared-use prperty added by `syntax' Effectively preserve `syntax-original?' of added identifiers. --- collects/racket/private/stxcase.rkt | 2 +- collects/tests/racket/macro.rktl | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/collects/racket/private/stxcase.rkt b/collects/racket/private/stxcase.rkt index 21683e867e..6b494e3e54 100644 --- a/collects/racket/private/stxcase.rkt +++ b/collects/racket/private/stxcase.rkt @@ -574,7 +574,7 @@ (syntax-e id) x)) 'disappeared-use - (car all-varss)) + (map syntax-local-introduce (car all-varss))) (loop (cdr vars) (cdr bindings) (cdr all-varss)))] [else (loop (cdr vars) (cdr bindings) (cdr all-varss))]))]) (if (identifier? pattern) diff --git a/collects/tests/racket/macro.rktl b/collects/tests/racket/macro.rktl index fdc31c388b..4b630cf462 100644 --- a/collects/tests/racket/macro.rktl +++ b/collects/tests/racket/macro.rktl @@ -761,6 +761,27 @@ ,e))) exn:fail?)) +;; ---------------------------------------- +;; Check that the `syntax' macro adds a +;; 'disappeared-use property that is +;; original (if it should be): + +(parameterize ([current-namespace (make-base-namespace)]) + (define stx (expand #'(with-syntax ([x 1]) #'x))) + (let sloop ([stx stx] + [in-prop? #f]) + (cond + [(and (identifier? stx) + (eq? 'x (syntax-e stx))) + (when in-prop? + (test #t syntax-original? stx))] + [(syntax? stx) + (sloop (syntax-property stx 'disappeared-use) #t) + (sloop (syntax-e stx) in-prop?)] + [(pair? stx) + (sloop (car stx) in-prop?) + (sloop (cdr stx) in-prop?)]))) + ;; ---------------------------------------- (err/rt-test (syntax-local-lift-require 'abc #'def))