Only generate poly contracts for functions
Closes PR 13815
(cherry picked from commit bafaf52056
)
This commit is contained in:
parent
90b149dc46
commit
a18bf85b4f
6
collects/tests/typed-racket/fail/pr13815.rkt
Normal file
6
collects/tests/typed-racket/fail/pr13815.rkt
Normal file
|
@ -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)
|
||||
|
|
@ -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)
|
||||
|
|
|
@ -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))])
|
||||
|
|
Loading…
Reference in New Issue
Block a user