Fix nested with-contracts by checking explicitly for ssps. Apparently

painting the bindings causes the ssp to later fail when you try to access
the parameter.  Not sure if this is a bug or not, will talk to Matthew.

svn: r13621

collects/scheme/private/contract.ss

@@ -214,7 +214,8 @@ improve method arity mismatch contract violation error messages?
     [(_ marker blame-stx ((p c) ...) (u ...) body0 body ...)
      (let ([expanded-body0 (local-expand #'body0
                                          (syntax-local-context)
-                                         (kernel-form-identifier-list))])
+                                         (cons #'splicing-syntax-parameterize
+                                               (kernel-form-identifier-list)))])
        (syntax-case expanded-body0 (begin define-values)
          [(begin sub ...)
           (syntax/loc stx
@@ -267,6 +268,19 @@ improve method arity mismatch contract violation error messages?
                        u-def ... p/c-def ...
                        (with-contract-helper marker blame-stx #,unused-p/cs #,unused-us
                                              body ...)))))]
+         [(splicing-syntax-parameterize bindings . ssp-body)
+          (let* ([marker-f (let ([marker (syntax-e #'marker)])
+                             (lambda (stx)
+                               (syntax-local-introduce
+                                (marker (syntax-local-introduce stx)))))]
+                 [expanded-ssp (local-expand (quasisyntax/loc expanded-body0
+                                               (splicing-syntax-parameterize bindings .
+                                                 #,(marker-f #'ssp-body)))
+                                             (syntax-local-context)
+                                             (kernel-form-identifier-list))])
+            (quasisyntax/loc stx
+              (begin #,expanded-ssp
+                     (with-contract-helper marker blame-stx ((p c) ...) (u ...) body ...))))]
          [else
           (let*-values ([(marker-f) (let ([marker (syntax-e #'marker)])
                                       (lambda (stx)

collects/tests/mzscheme/contract-test.ss

@@ -2476,7 +2476,53 @@
         (define (evenp n)
           (if (zero? n) #t (oddp (zero? n)))))
       (oddp 5)))
-
+  
+  (test/spec-passed
+   'with-contract5
+   '(let ()
+      (with-contract region1
+        ([x (-> number? number?)])
+        (with-contract region2
+          ([y (-> number? boolean?)])
+          (define (y n) #t))
+        (define (x n) (if (y n) 0 3)))
+      (x 4)))
+  
+  (test/spec-failed
+   'with-contract6
+   '(let ()
+      (with-contract region1
+        ([x (-> number? number?)])
+        (with-contract region2
+          ([y (-> number? boolean?)])
+          (define (y n) #t))
+        (define (x n) (y n)))
+      (x 4))
+   "(region region1)")
+  
+  (test/spec-failed
+   'with-contract7
+   '(let ()
+      (with-contract region1
+        ([x (-> number? number?)])
+        (with-contract region2
+          ([y (-> number? boolean?)])
+          (define (y n) #t))
+        (define (x n) (if (y #t) 4 0)))
+      (x 4))
+   "(region region1)")
+  
+  (test/spec-failed
+   'with-contract8
+   '(let ()
+      (with-contract region1
+        ([x (-> number? number?)])
+        (with-contract region2
+          ([y (-> number? boolean?)])
+          (define (y n) 3))
+        (define (x n) (if (y n) 4 0)))
+      (x 4))
+   "(region region2)")
 
 ;                                                                                                                         
 ;