From 3ff2184a38223fbc0b986e0b9f771eec2e16e59c Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Tue, 17 Feb 2009 20:50:56 +0000
Subject: [PATCH] Add the first-order free variable contract checks I mentioned
 earlier.

svn: r13707
---
 collects/scheme/private/contract.ss      |  6 ++++++
 collects/tests/mzscheme/contract-test.ss | 12 ++++++++++++
 2 files changed, 18 insertions(+)

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")
+  
 
 ;                                                                                  
 ;