diff --git a/pkgs/racket-test/tests/racket/contract/arrow.rkt b/pkgs/racket-test/tests/racket/contract/arrow.rkt index 6f17db0274..7f85c87d85 100644 --- a/pkgs/racket-test/tests/racket/contract/arrow.rkt +++ b/pkgs/racket-test/tests/racket/contract/arrow.rkt @@ -485,6 +485,36 @@ ((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11)) 'pos 'neg)) + (test/spec-passed/result + '->void.1 + '(void? ((contract (-> void?) void 'pos 'neg))) + #t) + (test/spec-passed/result + '->void.2 + '(void? ((contract (-> void?) (λ () (void)) 'pos 'neg))) + #t) + (test/spec-passed/result + '->void.3 + '(void? ((contract (-> void?) (λ args void) 'pos 'neg))) + #t) + (test/pos-blame + '->void.4 + '((contract (-> void?) (λ args 11) 'pos 'neg)) + #t) + (test/pos-blame + '->void.5 + '((contract (-> void?) (λ args (values (void) (void))) 'pos 'neg)) + #t) + (test/pos-blame + '->void.6 + '(contract (-> void?) 'not-a-function 'pos 'neg) + #t) + (test/pos-blame + '->void.7 + '(contract (-> void?) (λ (x) 1) 'pos 'neg) + #t) + + (test/spec-passed 'any/c-in-domain1 '((contract (-> any/c real?) diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt index 226d588e55..4f2e3ff799 100644 --- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt +++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt @@ -1080,6 +1080,122 @@ (define f 1))) (eval '(dynamic-require ''provide/contract56-m1 #f))) "provide/contract56-m1") + + (test/spec-failed + 'provide/contract57 + '(let () + (eval '(module provide/contract57-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> any/c boolean?)])) + (define f 1))) + (eval '(dynamic-require ''provide/contract57-m1 #f))) + "provide/contract57-m1") + + (test/spec-passed/result + 'provide/contract58 + '(let () + (eval '(module provide/contract58-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> any/c boolean?)])) + (define (f x) #t))) + (eval '(module provide/contract58-m2 racket/base + (require 'provide/contract58-m1) + (provide a) + (define a (f 1)))) + (eval '(dynamic-require ''provide/contract58-m2 'a))) + #t) + + (test/spec-failed + 'provide/contract59 + '(let () + (eval '(module provide/contract59-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> any/c boolean?)])) + (define (f x) 11))) + (eval '(module provide/contract59-m2 racket/base + (require 'provide/contract59-m1) + (f 1))) + (eval '(dynamic-require ''provide/contract59-m2 #f))) + "provide/contract59-m1") + + (test/spec-failed + 'provide/contract60 + '(let () + (eval '(module provide/contract60-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> any/c boolean?)])) + (define (f x) (values #t #t)))) + (eval '(module provide/contract60-m2 racket/base + (require 'provide/contract60-m1) + (f 1))) + (eval '(dynamic-require ''provide/contract60-m2 #f))) + "provide/contract60-m1") + + (test/spec-passed/result + 'provide/contract61 + '(let () + (eval '(module provide/contract61-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> void?)])) + (define (f) (void)))) + (eval '(module provide/contract61-m2 racket/base + (require 'provide/contract61-m1) + (provide a) + (define a (f)))) + (eval '(void? (dynamic-require ''provide/contract61-m2 'a)))) + #t) + + (test/spec-failed + 'provide/contract62 + '(let () + (eval '(module provide/contract62-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> void?)])) + (define f 1))) + (eval '(dynamic-require ''provide/contract62-m1 #f))) + "provide/contract62-m1") + + (test/spec-failed + 'provide/contract63 + '(let () + (eval '(module provide/contract63-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> void?)])) + (define (f) 11))) + (eval '(module provide/contract63-m2 racket/base + (require 'provide/contract63-m1) + (f))) + (eval '(dynamic-require ''provide/contract63-m2 #f))) + "provide/contract63-m1") + + (test/spec-failed + 'provide/contract64 + '(let () + (eval '(module provide/contract64-m1 racket/base + (require racket/contract/base) + (provide + (contract-out + [f (-> void?)])) + (define (f) (values #t #t)))) + (eval '(module provide/contract64-m2 racket/base + (require 'provide/contract64-m1) + (f))) + (eval '(dynamic-require ''provide/contract64-m2 #f))) + "provide/contract64-m1") (contract-error-test diff --git a/pkgs/racket-test/tests/racket/contract/name.rkt b/pkgs/racket-test/tests/racket/contract/name.rkt index 4f413551af..aa5badbcea 100644 --- a/pkgs/racket-test/tests/racket/contract/name.rkt +++ b/pkgs/racket-test/tests/racket/contract/name.rkt @@ -69,6 +69,9 @@ (test-name 'predicate/c predicate/c) (test-name '(-> integer? any/c ... boolean? any) (-> integer? any/c ... boolean? any)) + + (test-name '(-> boolean?) (-> boolean?)) + (test-name '(-> void?) (-> void?)) (test-name '(->* (integer?) (string?) #:rest any/c (values char? any/c)) (->* (integer?) (string?) #:rest any/c (values char? any/c))) diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt index cc4555bd83..d73f0cf01f 100644 --- a/racket/collects/racket/contract/private/arrow-val-first.rkt +++ b/racket/collects/racket/contract/private/arrow-val-first.rkt @@ -954,10 +954,6 @@ (for/list ([rng (in-list raw-rngs)]) (coerce-contract who rng)))) (cond - ;; uncomment this to specialize (-> void) contract to a - ;; more efficient wrapper (but there are no test cases for - ;; that code, so add them before pushing this) - #; [(and (null? regular-doms) (null? kwd-infos) (not rest-ctc) @@ -1447,7 +1443,7 @@ (make--> 0 '() '() #f #f (list (coerce-contract 'whatever void?)) #f - (λ (blame f _ignored-rng-ctcs _ignored-rng-proj) + (λ (blame f _ignored) (values (λ (neg-party) (call-with-values/check-range