diff --git a/pkgs/racket-test/tests/racket/contract/rename.rkt b/pkgs/racket-test/tests/racket/contract/rename.rkt new file mode 100644 index 0000000000..2c6488a8d0 --- /dev/null +++ b/pkgs/racket-test/tests/racket/contract/rename.rkt @@ -0,0 +1,70 @@ +#lang racket/base +(require "test-util.rkt") + +(parameterize ([current-contract-namespace + (make-basic-contract-namespace + 'racket/contract/parametric)]) + + (test/spec-passed/result + 'rename1 + '(contract-name + (rename-contract (-> integer? integer?) + 'another-name)) + 'another-name) + + (test/spec-passed/result + 'rename2 + '(chaperone-contract? + (rename-contract (-> integer? integer?) + 'another-name)) + #t) + + (test/spec-passed/result + 'rename3 + '(contract-name + (rename-contract integer? 'another-name)) + 'another-name) + + (test/spec-passed/result + 'rename4 + '(flat-contract? + (rename-contract integer? 'another-name)) + #t) + + (test/spec-passed/result + 'rename5 + '(contract-name + (rename-contract integer? 'another-name)) + 'another-name) + + (test/spec-passed/result + 'rename6 + '(flat-contract? + (rename-contract (new-∀/c 'alpha) 'α)) + #f) + + (test/spec-passed/result + 'rename7 + '(chaperone-contract? + (rename-contract (new-∀/c 'alpha) 'α)) + #f) + + (test/spec-passed/result + 'rename8 + '(contract? + (rename-contract (new-∀/c 'alpha) 'α)) + #t) + + (test/pos-blame + 'rename9 + '((contract (rename-contract (-> integer? integer?) 'whatever) + (λ (x) #f) + 'pos 'neg) + 1)) + + (test/neg-blame + 'rename10 + '((contract (rename-contract (-> integer? integer?) 'whatever) + (λ (x) x) + 'pos 'neg) + #f))) diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt index 301f086a6c..5afebeb255 100644 --- a/racket/collects/racket/contract/private/misc.rkt +++ b/racket/collects/racket/contract/private/misc.rkt @@ -1994,7 +1994,7 @@ (define (stronger? this other) (contract-stronger? ctc other)) (make-contract #:name name - #:projection (contract-projection ctc) + #:late-neg-projection (contract-late-neg-projection ctc) #:first-order (contract-first-order ctc) #:stronger stronger? #:list-contract? (list-contract? ctc))))))