Fix rest arg contract generation for case-> types

takikawa · takikawa · commit fce98517e6ba · 2014-05-16T14:59:43.000-04:00
The generated contracts are still not ideal when more than
one case has a rest argument, since a later case in the
case-&gt; contract may pass but case-&gt; won't try all of them.
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
@@ -515,7 +515,7 @@
                                      " with optional keyword arguments")))
                 (if case->
                   (arr/sc (process-dom (map t->sc/neg dom))
-                          (and rst (t->sc/neg rst))
+                          (and rst (listof/sc (t->sc/neg rst)))
                           (map t->sc rngs))
                   (function/sc
                     (process-dom (map t->sc/neg dom))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/contract-tests.rkt
@@ -213,4 +213,9 @@
                           (λ (x) 1)
                           #:untyped
                           #:msg #rx"produced: 1.*blaming: untyped")
+              (t-int (cl->* (->* '() -String -String)
+                            (->* (list -Symbol) -Symbol -Symbol))
+                     (λ (f) (f "a" "b"))
+                     (case-lambda [xs (car xs)]
+                                  [(sym . xs) sym]))
               ))
