From 7a657d334ff6ebf663874b0c65ddc28368e45104 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Fri, 14 Nov 2008 16:48:17 +0000
Subject: [PATCH] Add all changes from branches/with-contract (which this
 branch will replace eventually), plus a couple of fixes in contract-test.ss.

svn: r12451

original commit: 3212d1171217a93eb2865a602092d5b5d842ff40
---
 collects/mzlib/contract.ss                    | 11 +++++++++-
 .../tests/mzscheme/contract-mzlib-test.ss     | 20 +++++++++----------
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index bf96a1c..a191881 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -15,6 +15,13 @@
 (require "private/contract-object.ss")
 (provide (all-from-out "private/contract-object.ss"))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; old-style define/contract
+;;
+
+(require "private/contract-define.ss")
+(provide (all-from-out "private/contract-define.ss"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -22,7 +29,9 @@
 ;; except the arrow contracts
 ;;
 
-(require scheme/private/contract
+(require (except-in scheme/private/contract
+                    define/contract
+                    with-contract)
          scheme/private/contract-guts
          scheme/private/contract-ds
          scheme/private/contract-opt
diff --git a/collects/tests/mzscheme/contract-mzlib-test.ss b/collects/tests/mzscheme/contract-mzlib-test.ss
index 4d0b8c9..47e25f7 100644
--- a/collects/tests/mzscheme/contract-mzlib-test.ss
+++ b/collects/tests/mzscheme/contract-mzlib-test.ss
@@ -81,7 +81,7 @@ of the contract library does not change over time.
         (equal?
          blame
          (cond
-           [(regexp-match #rx"(^| )([^ ]*) broke" msg) 
+           [(regexp-match #rx"(^| )(.*) broke" msg) 
             =>
             (λ (x) (caddr x))]
            [else (format "no blame in error message: \"~a\"" msg)])))
@@ -103,8 +103,8 @@ of the contract library does not change over time.
                (and (exn? exn)
                     (,has-proper-blame? (exn-message exn))))))))))
   
-  (define (test/pos-blame name expression) (test/spec-failed name expression "pos"))
-  (define (test/neg-blame name expression) (test/spec-failed name expression "neg"))
+  (define (test/pos-blame name expression) (test/spec-failed name expression "module pos"))
+  (define (test/neg-blame name expression) (test/spec-failed name expression "module neg"))
   
   (define (test/well-formed stx)
     (contract-eval
@@ -126,7 +126,7 @@ of the contract library does not change over time.
         (contract-eval `(,test #t flat-contract? ,contract))
         (test/spec-failed (format "~a fail" name)
                           `(contract ,contract ',fail 'pos 'neg)
-                          "pos")
+                          "module pos")
         (test/spec-passed/result
          (format "~a pass" name)
          `(contract ,contract ',pass 'pos 'neg)
@@ -1577,14 +1577,14 @@ of the contract library does not change over time.
    '(let ()
       (define/contract i integer? #t)
       i)
-   "i")
+   "definition i")
   
   (test/spec-failed
    'define/contract3
    '(let ()
       (define/contract i (-> integer? integer?) (lambda (x) #t))
       (i 1))
-   "i")
+   "definition i")
   
   (test/spec-failed
    'define/contract4
@@ -4643,7 +4643,7 @@ so that propagation occurs.
                (provide/contract (x integer?))))
       (eval '(require 'contract-test-suite3))
       (eval 'x))
-   "'contract-test-suite3")
+   "module 'contract-test-suite3")
   
   (test/spec-passed
    'provide/contract4
@@ -4820,7 +4820,7 @@ so that propagation occurs.
                             (make-s 1 2)
                             [s-a #f])))
       (eval '(require 'pc11b-n)))
-   'n)
+   "module 'n")
 |#
   
   (test/spec-passed
@@ -4888,7 +4888,7 @@ so that propagation occurs.
                (define i #f)
                (provide/contract [i integer?])))
       (eval '(require 'pos)))
-   "'pos")
+   "module 'pos")
   
   ;; this is really a positive violation, but name the module `neg' just for an addl test
   (test/spec-failed
@@ -4899,7 +4899,7 @@ so that propagation occurs.
                (define i #f)
                (provide/contract [i integer?])))
       (eval '(require 'neg)))
-   "'neg")
+   "module 'neg")
   
   ;; this test doesn't pass yet ... waiting for support from define-struct