suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix type error reporting for case-> with * domains

Browse Source 
In the case that a case-> type included a case with a *
domain and had additional branches, a use of `apply` with
that type would fail to report a type error. This was
because the type of the applied list was ignored for type
error generation.

Closes PR 13893

original commit: 328956e8b5cd9b9c6256b1eac4f46aec98ce2a5d
This commit is contained in:
Asumu Takikawa 2013-07-05 17:41:17 -04:00
parent 9c7ea3f871
commit a200e03b19
2 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -101,7 +101,6 @@
(define (domain-mismatches f-stx args-stx ty doms rests drests rngs arg-tys tail-ty tail-bound
#:expected [expected #f] #:return [return -Bottom]
#:msg-thunk [msg-thunk (lambda (dom) dom)])
(define arguments-str
(stringify-domain arg-tys
(if (not tail-bound) tail-ty #f)
@ -155,7 +154,9 @@
(if (null? pdoms)
(values doms rngs rests drests)
(values pdoms prngs prests pdrests))])
(if (= (length pdoms) 1)
(if ;; only use `tc/funapp1` if `tail-ty` was *not* provided
;; since it either won't error correctly or produces a poor error
(and (not tail-ty) (= (length pdoms) 1))
;; if we narrowed down the possible cases to a single one, have
;; tc/funapp1 generate a better error message
(begin (tc/funapp1 f-stx args-stx

21
pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/fail/pr13893.rkt Normal file
View File

@ -0,0 +1,21 @@
#;
(exn:pred #rx"Bad arguments to function in apply")
#lang typed/racket
;; Make sure that case-> types with multiple branches that
;; includes a * domain produce a type error instead of
;; accidentally type-checking.
;; from the PR
(: x (Listof Number))
(define x (apply + (list 1 2 "3")))
(: g (-> (Listof Number)))
(define (g) (apply + (list 1 2 "3")))
;; additional case
(: f (case-> (Integer * -> Integer)
(Real * -> Real)))
(define (f . args) (+ 1 (list-ref args 2)))
(apply f (list 1 2 "3"))