diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl index cab5a73fa0..4e9c04e96a 100644 --- a/pkgs/racket-test-core/tests/racket/syntax.rktl +++ b/pkgs/racket-test-core/tests/racket/syntax.rktl @@ -1854,6 +1854,25 @@ (read i))) (test (syntax->datum (eval v)) syntax->datum (eval e))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check that expansion of `apply` into the keyword `apply` +;; doesn't create a confusing inferred name: + +(define proc-that-accepts-anything (make-keyword-procedure void)) +(proc-that-accepts-anything #:contract + (apply proc-that-accepts-anything + null + #:flat? #t)) +(let-syntax ([x (lambda (stx) + (syntax-property + (datum->syntax stx + (cons #'proc-that-accepts-anything + (cdr (syntax-e stx)))) + 'inferred-name + "non-symbol"))]) + (proc-that-accepts-anything #:contract + (x #:flag? #t))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/collects/racket/private/kw.rkt b/racket/collects/racket/private/kw.rkt index 7628b8edec..9f6a360a63 100644 --- a/racket/collects/racket/private/kw.rkt +++ b/racket/collects/racket/private/kw.rkt @@ -954,7 +954,7 @@ [else (cons (car l) (loop (cdr l)))])))]) (let* ([name (syntax-local-infer-name stx #f)] - [ids (cons (if name + [ids (cons (if (and name (or (identifier? name) (symbol? name))) (if (syntax? name) name (datum->syntax #f name)) (datum->syntax #f 'procedure)) (generate-temporaries exprs))])