From 6b45173588b8d05a3a6c5c3f35d39ce91c10ea63 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 6 Apr 2013 12:05:57 -0700 Subject: [PATCH] Correctly protect Procedures in TR. Closes PR 13664. original commit: fc36c12ce4df96cca4df053fa5e0f4c4969b7e8a --- collects/tests/typed-racket/fail/pr13664.rkt | 20 +++++++++++++++++++ .../typed-racket/private/type-contract.rkt | 2 +- 2 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 collects/tests/typed-racket/fail/pr13664.rkt diff --git a/collects/tests/typed-racket/fail/pr13664.rkt b/collects/tests/typed-racket/fail/pr13664.rkt new file mode 100644 index 00000000..c081ff59 --- /dev/null +++ b/collects/tests/typed-racket/fail/pr13664.rkt @@ -0,0 +1,20 @@ +#; +(exn-pred #rx"arity mismatch") +#lang racket/load + +(module untyped racket + (provide f) + (define (f g) + (g "foo"))) + + +(module typed typed/racket + (require/typed 'untyped + [f (Procedure -> Any)]) + + (: g (Byte -> Natural)) + (define (g x) (add1 x)) + + (f g)) + +(require 'typed) diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 8b067b99..ae0c4085 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -129,7 +129,7 @@ (loop t (not pos?) (not from-typed?) structs-seen kind)) (define (t->c/fun f #:method [method? #f]) (match f - [(Function: (list (top-arr:))) (if pos? #'(case->) #'procedure?)] + [(Function: (list (top-arr:))) #'(case->)] [(Function: arrs) (set-chaperone!) ;; Try to generate a single `->*' contract if possible.