diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss index d0a26df997..f3e2731138 100644 --- a/collects/scheme/private/contract.ss +++ b/collects/scheme/private/contract.ss @@ -317,6 +317,7 @@ improve method arity mismatch contract violation error messages? (marker (a:mangle-id stx "with-contract-contract-id" i))) free-vars)] [(free-ctc ...) free-ctcs] + [(free-src-info ...) (map id->contract-src-info free-vars)] [(ctc-id ...) (map (λ (i) (marker (a:mangle-id stx "with-contract-contract-id" i))) protected)] @@ -348,6 +349,11 @@ improve method arity mismatch contract violation error messages? blame-stx 'cant-happen src-info) ... + (-contract free-ctc-id + free-var + blame-id + 'cant-happen + free-src-info) ... (values))) (define-syntaxes (u ... p ...) (values (make-rename-transformer #'marked-u) ... diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index 889578f278..b009255492 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -2465,6 +2465,18 @@ (f 5)) "(function f)") + (test/spec-failed + 'define/contract25 + '(let () + (define y #t) + (define z 3) + (define/contract f + number? + #:freevars ([y number?] [z number?]) + (+ y z)) + 1) + "top-level") + ; ;