From 35a716d5d36b4995c025d3e46089e3dea7a09dc8 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <cce@racket-lang.org>
Date: Tue, 19 Jan 2010 07:14:17 +0000
Subject: [PATCH] Fixed blame detection regexp.

svn: r17742
---
 collects/tests/mzscheme/contract-mzlib-test.ss | 16 ++++++++--------
 collects/tests/mzscheme/contract-test.ss       | 10 +++-------
 2 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/collects/tests/mzscheme/contract-mzlib-test.ss b/collects/tests/mzscheme/contract-mzlib-test.ss
index 2e22f4145b..fa7a9139af 100644
--- a/collects/tests/mzscheme/contract-mzlib-test.ss
+++ b/collects/tests/mzscheme/contract-mzlib-test.ss
@@ -78,13 +78,9 @@ of the contract library does not change over time.
   (define (test/spec-failed name expression blame)
     (let ()
       (define (has-proper-blame? msg)
-        (equal?
-         blame
-         (cond
-           [(regexp-match #rx"(^| )(.*) broke" msg) 
-            =>
-            (λ (x) (caddr x))]
-           [else (format "no blame in error message: \"~a\"" msg)])))
+        (regexp-match?
+         (string-append "(^| )" (regexp-quote blame) " broke")
+         msg))
       (printf "testing: ~s\n" name)
       (contract-eval
        `(,thunk-error-test 
@@ -5127,7 +5123,11 @@ so that propagation occurs.
      (and (exn? x)
           (regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
   
-  (contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg))))
+  (contract-eval
+   `(,test
+     'pos
+     (compose blame-guilty exn:fail:contract:blame-object)
+     (with-handlers ((void values)) (contract not #t 'pos 'neg))))
   
   (report-errs)
   
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 1fbed1a41a..ee58ba9e02 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -73,13 +73,9 @@
   (define (test/spec-failed name expression blame)
     (let ()
       (define (has-proper-blame? msg)
-        (equal?
-         blame
-         (cond
-           [(regexp-match #rx"(^| )(.*) broke" msg) 
-            =>
-            (λ (x) (caddr x))]
-           [else (format "no blame in error message: \"~a\"" msg)])))
+        (regexp-match?
+         (string-append "(^| )" (regexp-quote blame) " broke")
+         msg))
       (printf "testing: ~s\n" name)
       (contract-eval
        `(,thunk-error-test