diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index ebceb5bc1d..71337dbf74 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -423,6 +423,48 @@ [(eq? v 'do-not-forget-me) #t] [else #f])))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check that 'origin has the right source location + +(let () + (define m #'(module m racket/base + (require (for-syntax racket/base)) + (let () + (define-values (x y) (values 1 2)) + x))) + (define e (expand m)) + (define dv-src + (let loop ([m m]) + (cond + [(syntax? m) + (or (and (eq? (syntax-e m) 'define-values) + m) + (loop (syntax-e m)))] + [(pair? m) (or (loop (car m)) (loop (cdr m)))] + [else #f]))) + (define dv-origin + (let loop ([e e]) + (cond + [(syntax? e) + (define p (syntax-property e 'origin)) + (or (let loop ([p p]) + (cond + [(and (identifier? p) + (eq? (syntax-e p) 'define-values)) + p] + [(pair? p) (or (loop (car p)) (loop (cdr p)))] + [else #f])) + (loop (syntax-e e)))] + [(pair? e) (or (loop (car e)) (loop (cdr e)))] + [else #f]))) + (test (list (syntax-line dv-src) + (syntax-column dv-src) + (syntax-span dv-src)) + list + (syntax-line dv-origin) + (syntax-column dv-origin) + (syntax-span dv-origin))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check property tracking on `let[rec]-values` binding clauses diff --git a/racket/src/expander/expand/main.rkt b/racket/src/expander/expand/main.rkt index 27c3b4ebcc..645e622eeb 100644 --- a/racket/src/expander/expand/main.rkt +++ b/racket/src/expander/expand/main.rkt @@ -719,6 +719,11 @@ (cond [(expand-context-to-parsed? ctx) (and (or keep-for-parsed? keep-for-error?) (datum->syntax #f keep-e s s))] + [(and for-track? (pair? d) keep-e) + ;; Use properties of `s`, but binding and source location of identifier + (define id (car d)) + (syntax-rearm (datum->syntax (syntax-disarm id) keep-e id s) + id)] [else (syntax-rearm (datum->syntax (syntax-disarm s) keep-e s s) s)])) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index abb35b8a1d..04b256a073 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -40577,7 +40577,7 @@ static const char *startup_source = " 'keep-as-needed119" "(let-values(((ctx_0) ctx117_0))" "(let-values(((s_0) s118_0))" -"(let-values()" +"(let-values(((for-track?_0) for-track?111_0))" "(let-values(((keep-for-parsed?_0) keep-for-parsed?112_0))" "(let-values(((keep-for-error?_0) keep-for-error?113_0))" "(let-values()" @@ -40593,8 +40593,12 @@ static const char *startup_source = "(if(let-values(((or-part_0) keep-for-parsed?_0))(if or-part_0 or-part_0 keep-for-error?_0))" "(datum->syntax$1 #f keep-e_0 s_0 s_0)" " #f))" +"(if(if for-track?_0(if(pair? d_0) keep-e_0 #f) #f)" "(let-values()" -"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 s_0) keep-e_0 s_0 s_0) s_0))))))))))))))" +"(let-values(((id_0)(car d_0)))" +"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 id_0) keep-e_0 id_0 s_0) id_0)))" +"(let-values()" +"(syntax-rearm$1(datum->syntax$1(syntax-disarm$1 s_0) keep-e_0 s_0 s_0) s_0)))))))))))))))" "(define-values" "(attach-disappeared-transformer-bindings)" "(lambda(s_0 trans-idss_0)"