Check expected type before calling tc/funapp1

This compensates for a change in commit bb3f446186
that made the possible-domains function more permissive
(possibly returning results that are inconsistent with the
 expected type).

Closes PR 14889
This commit is contained in:
Asumu Takikawa 2014-12-31 22:36:01 -05:00
parent 643c20afdb
commit 6059fb481b
2 changed files with 14 additions and 2 deletions

View File

@ -4,7 +4,7 @@
racket/match unstable/list unstable/sequence racket/set racket/list
(only-in srfi/1 unzip4) (only-in racket/list make-list)
(contract-req)
(typecheck check-below tc-subst)
(typecheck check-below tc-subst tc-metafunctions)
(utils tc-utils)
(rep type-rep filter-rep)
(except-in (types utils abbrev subtype)
@ -158,7 +158,15 @@
(values pdoms prngs prests pdrests))])
;; only use `tc/funapp1` if `tail-ty` was *not* provided
;; since it either won't error correctly or produces a poor error
(cond [(and (not tail-ty) (= (length pdoms) 1))
(cond [(and (not tail-ty)
(= (length pdoms) 1)
;; The correctness of selecting this case depends on the
;; domain selection being consistent with the expected
;; type. Since possible-domains only checks this in restrictive
;; mode, do the check here. Note that using restrictive mode
;; above results in poor error messages (see PR 14731).
(or (not expected)
(subtype (car rngs) (tc-results->values expected))))
;; if we narrowed down the possible cases to a single one, have
;; tc/funapp1 generate a better error message
(tc/funapp1 f-stx args-stx

View File

@ -3424,6 +3424,10 @@
(car p))))
(void))
-Void]
;; PR 14889
[tc-err (ann (vector-ref (ann (vector "hi") (Vectorof String)) 0) Symbol)
#:msg #rx"Polymorphic function.*could not be applied"]
)
(test-suite