diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/contract-out.rkt index d5ad1ede44..3e328d2738 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/contract-out.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/contract-out.rkt @@ -1076,6 +1076,21 @@ 'pos 'neg)))) (eval '(require 'contract-struct/c-2b)))) + (test/spec-passed/result + 'contract-out-rename1 + '(begin + (eval '(module contract-out-rename1-a racket/base + (require racket/contract/base) + (provide (prefix-out my- (contract-out [f any/c]))) + (define f 11))) + (eval '(module contract-out-rename1-b racket/base + (require 'contract-out-rename1-a) + (define contract-out-rename1-my-f my-f) + (provide contract-out-rename1-my-f))) + (eval '(require 'contract-out-rename1-b)) + (eval 'contract-out-rename1-my-f)) + 11) + (contract-eval diff --git a/racket/collects/racket/contract/private/out.rkt b/racket/collects/racket/contract/private/out.rkt index 58cf0f9d07..e042d190e7 100644 --- a/racket/collects/racket/contract/private/out.rkt +++ b/racket/collects/racket/contract/private/out.rkt @@ -21,9 +21,38 @@ ;; check for syntax errors (true-provide/contract stx #t 'contract-out) - (syntax-case stx () - [(_ . args) - (syntax-local-lift-module-end-declaration - #`(provide/contract-for-contract-out . args))]) - - #`(combine-out)))) + (with-syntax ([(contracted-vars-info) (generate-temporaries '(contracted-vars-info))]) + (syntax-local-lift-module-end-declaration + #`(handle-contract-out contracted-vars-info #,stx)) + + #`(provide-contracted-vars contracted-vars-info))))) + +(define-syntax (handle-contract-out stx) + (syntax-case stx () + [(_ contracted-vars-info orig-stx) + (let () + (define provide-clauses '()) + (define without-provide-clauses + (let loop ([stx (true-provide/contract #'orig-stx #f 'contract-out)]) + (syntax-case stx (begin provide) + [(begin args ...) + #`(begin #,@(map loop (syntax->list #'(args ...))))] + [(provide clause ...) + (identifier? #'x) + (begin (set! provide-clauses (append (syntax->list #'(clause ...)) + provide-clauses)) + #'(begin))] + [x stx]))) + #`(begin + #,without-provide-clauses + (define-syntax contracted-vars-info (quote-syntax #,provide-clauses))))])) + +(define-syntax provide-contracted-vars + (make-provide-transformer + (λ (stx modes) + (define contracted-vars-info + (syntax-case stx () + [(_ id) #'id])) + (for*/list ([provide-clause (in-list (syntax->list (syntax-local-value contracted-vars-info)))] + [export (in-list (expand-export provide-clause modes))]) + export))))