diff --git a/collects/racket/private/qqstx.rkt b/collects/racket/private/qqstx.rkt index 12103d98ab..d823b43c07 100644 --- a/collects/racket/private/qqstx.rkt +++ b/collects/racket/private/qqstx.rkt @@ -241,6 +241,16 @@ stx stx) bindings)))] + [(prefab-struct-key (syntax-e stx)) + (let* ([d (syntax-e stx)] + [key (prefab-struct-key d)] + [fields (cdr (vector->list (struct->vector d)))]) + (loop (datum->syntax stx fields stx) + depth + same-k + (lambda (v bindings) + (let ([p (apply make-prefab-struct key (syntax->list v))]) + (convert-k (datum->syntax stx p stx stx) bindings)))))] [else (same-k)])]))))] [qq (lambda (orig-stx body mk-final) diff --git a/collects/tests/racket/stx.rktl b/collects/tests/racket/stx.rktl index e71eb19805..d345ee1434 100644 --- a/collects/tests/racket/stx.rktl +++ b/collects/tests/racket/stx.rktl @@ -1717,6 +1717,25 @@ (dynamic-require ''mm-context-m3 #f)) (test #"1\n2\n" get-output-bytes o)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check `quasisyntax' finds `unsyntax' + +(with-syntax ([a #'1] [(c ...) #'(3 4 5)]) + (let ([b #'2] [ds (list #'3 #'4 #'5)]) + (test '(1 2) syntax->datum (quasisyntax (a (unsyntax b)))) + (test '(2 1) syntax->datum (quasisyntax ((unsyntax b) a))) + (test '(1 . 2) syntax->datum (quasisyntax (a unsyntax b))) + (test '((1) (2)) syntax->datum (quasisyntax ((a) ((unsyntax b))))) + (test '#(1 2) syntax->datum (quasisyntax #(a (unsyntax b)))) + (test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) c ...))) + (test '#s(PS 1 2) syntax->datum (quasisyntax #s(PS a (unsyntax b)))) + (test '#s(PS 1 2 3 4 5) syntax->datum (quasisyntax #s(PS a (unsyntax b) c ...))) + #| + (test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) (unsyntax-splicing ds)))) + (test '#s(PS 1 2 3 4 5) syntax->datum + (quasisyntax #s(PS a (unsyntax b) (unsyntax-splicing ds)))) + |#)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check preservation of properties by `quasisyntax'