From b56019c275925a4684fa1fe12b25733f74afa5c4 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 14 Aug 2010 21:32:13 -0500
Subject: [PATCH] generalized check-exn so that you can supply a regular
 expression as the predicate (which matches the exception message)

---
 collects/rackunit/private/check.rkt       | 55 ++++++++++++-----------
 collects/rackunit/scribblings/check.scrbl | 18 ++++----
 2 files changed, 39 insertions(+), 34 deletions(-)

diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt
index c67285d449..148d33f262 100644
--- a/collects/rackunit/private/check.rkt
+++ b/collects/rackunit/private/check.rkt
@@ -195,32 +195,35 @@
               #t
               (fail-check)))))]))
 
-(define-check (check-exn pred thunk)
-  (let/ec succeed
-    (with-handlers
-        (;; catch the exception we are looking for and
-         ;; succeed
-         [pred
-          (lambda (exn) (succeed #t))]
-         ;; rethrow check failures if we aren't looking
-         ;; for them
-         [exn:test:check?
-          (lambda (exn)
-            (refail-check exn))]
-         ;; catch any other exception and raise an check
-         ;; failure
-         [exn:fail?
-          (lambda (exn)
-            (with-check-info*
-             (list
-              (make-check-message "Wrong exception raised")
-              (make-check-info 'exn-message (exn-message exn))
-              (make-check-info 'exn exn))
-             (lambda () (fail-check))))])
-      (thunk))
-    (with-check-info*
-     (list (make-check-message "No exception raised"))
-     (lambda () (fail-check)))))
+(define-check (check-exn raw-pred thunk)
+  (let ([pred (if (regexp? raw-pred)
+                  (λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))
+                  raw-pred)])
+    (let/ec succeed
+      (with-handlers
+          (;; catch the exception we are looking for and
+           ;; succeed
+           [pred
+            (lambda (exn) (succeed #t))]
+           ;; rethrow check failures if we aren't looking
+           ;; for them
+           [exn:test:check?
+            (lambda (exn)
+              (refail-check exn))]
+           ;; catch any other exception and raise an check
+           ;; failure
+           [exn:fail?
+            (lambda (exn)
+              (with-check-info*
+               (list
+                (make-check-message "Wrong exception raised")
+                (make-check-info 'exn-message (exn-message exn))
+                (make-check-info 'exn exn))
+               (lambda () (fail-check))))])
+        (thunk))
+      (with-check-info*
+       (list (make-check-message "No exception raised"))
+       (lambda () (fail-check))))))
 
 (define-check (check-not-exn thunk)
   (with-handlers
diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl
index 869bfc25b6..7ff509e937 100644
--- a/collects/rackunit/scribblings/check.scrbl
+++ b/collects/rackunit/scribblings/check.scrbl
@@ -98,11 +98,14 @@ For example, the following checks all fail:
 ]
 
 
-@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
+@defproc[(check-exn (exn-predicate (or/c (-> any (or/c #t #f)) regexp?)) (thunk (-> any)) (message string? ""))
          #t]{
-
-Checks that @racket[thunk] raises an exception for which
-@racket[exn-predicate] returns @racket[#t].  The optional
+Checks that @racket[thunk] raises an exception and that
+either @racket[exn-predicate] returns @racket[#t] if it is a function,
+or that it matches the message in the exception if @racket[exn-predicate]
+is a regexp. In the latter case, the exception raised must be
+an @racket[exn:fail?].
+The optional
 @racket[message] is included in the output if the check
 fails.  A common error is to use an expression instead of a
 function of no arguments for @racket[thunk].  Remember that
@@ -111,14 +114,13 @@ checks are conceptually functions.}
 Here are two example, one showing a test that succeeds, and one showing a common error:
 
 @racketblock[
-  (check-exn exn? 
+  (check-exn exn:fail? 
              (lambda ()
                (raise (make-exn "Hi there"
                                 (current-continuation-marks)))))
   (code:comment "Forgot to wrap the expression in a thunk.  Don't do this!")
-  (check-exn exn?
-             (raise (make-exn "Hi there"
-                              (current-continuation-marks))))
+  (check-exn exn:fail?
+             (error 'hi "there"))
 ]
 
 @defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{