diff --git a/collects/tests/typed-racket/fail/pr13815.rkt b/collects/tests/typed-racket/fail/pr13815.rkt new file mode 100644 index 0000000000..c78e19357f --- /dev/null +++ b/collects/tests/typed-racket/fail/pr13815.rkt @@ -0,0 +1,6 @@ +#; +(exn:pred #rx"Type (All (a) Flonum) could not be converted to a contract") +#lang typed/racket +(require/typed racket/base [list (All (a) Float)]) +(* 3.3 list) + diff --git a/collects/tests/typed-racket/unit-tests/contract-tests.rkt b/collects/tests/typed-racket/unit-tests/contract-tests.rkt index 72ab089863..2cd0de7ad4 100644 --- a/collects/tests/typed-racket/unit-tests/contract-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/contract-tests.rkt @@ -21,7 +21,13 @@ (t (-Number . -> . -Number)) (t (-Promise -Number)) (t (-set Univ)) - )) + ;; Adapted from PR 13815 + (t (-poly (a) (-> a a))) + (t (-poly (a) (-mu X (-> a X)))) + (t (-poly (a) (-poly (b) (-> a a)))) + (t (-poly (a) (-App (-poly (b) (-> a a)) (list -Number) #'#f))) + (t/fail (-poly (a) -Flonum)) + (t/fail (-poly (a) (-set -Number))))) (define-go contract-tests) (provide contract-tests) diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 39aede51a6..bde0a76f0a 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -375,6 +375,17 @@ [(F: v) (cond [(assoc v (vars)) => second] [else (int-err "unknown var: ~a" v)])] [(Poly: vs b) + ;; Don't generate poly contracts for non-functions + (define function-type? + (let loop ([ty ty]) + (match (resolve ty) + [(Function: _) #t] + [(Union: elems) (andmap loop elems)] + [(Poly: _ body) (loop body)] + [(PolyDots: _ body) (loop body)] + [_ #f]))) + (unless function-type? + (exit (fail))) (if (not (from-untyped? typed-side)) ;; in typed positions, no checking needed for the variables (parameterize ([vars (append (for/list ([v (in-list vs)]) (list v #'any/c)) (vars))])