From b45b111960a39728d35513d5d0616bd3c948bbc7 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 10 May 2011 17:09:26 -0600
Subject: [PATCH] rackunit: don't assume raised value is exn   Closes PR 11632

---
 collects/rackunit/private/check.rkt     |  6 +++---
 collects/rackunit/private/format.rkt    | 12 ++++++++----
 collects/rackunit/private/test-case.rkt |  4 ++--
 collects/rackunit/text-ui.rkt           |  3 ++-
 4 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt
index 87af84ad12..6d40468af0 100644
--- a/collects/rackunit/private/check.rkt
+++ b/collects/rackunit/private/check.rkt
@@ -33,11 +33,11 @@
          check-not-equal?
          fail)
 
-;; default-check-handler : exn -> any
+;; default-check-handler : any -> any
 (define (default-check-handler e)
   (display-test-failure/error e))
 
-;; parameter current-check-handler : (-> exn any)
+;; parameter current-check-handler : (-> any any)
 (define current-check-handler
   (make-parameter
    default-check-handler
@@ -48,7 +48,7 @@
 
 ;; check-around : ( -> a) -> a
 (define (check-around thunk)
-  (with-handlers ([exn? (current-check-handler)])
+  (with-handlers ([(lambda (e) #t) (current-check-handler)])
     (thunk)))
 
 ;; top-level-check-around : ( -> a) -> a
diff --git a/collects/rackunit/private/format.rkt b/collects/rackunit/private/format.rkt
index 8f43de7a35..958f79943a 100644
--- a/collects/rackunit/private/format.rkt
+++ b/collects/rackunit/private/format.rkt
@@ -58,13 +58,16 @@
       (begin
         (display "Unnamed test ")(newline))))
 
-;; display-exn : exn -> void
+;; display-exn : any -> void
 ;;
 ;; Outputs a printed representation of the exception to
 ;; the current-output-port
-(define (display-exn exn)
+;; If given non-exn value, says so.
+(define (display-exn v)
   (parameterize ((current-error-port (current-output-port)))
-    ((error-display-handler) (exn-message exn) exn)
+    (if (exn? v)
+        ((error-display-handler) (exn-message v) v)
+        (printf "A value other than an exception was raised: ~e\n" v))
     (newline)))
 
 ;; ----
@@ -93,6 +96,7 @@
 
 ;; ----
 
+;; display-test-failure/error : any string/#f -> void
 (define (display-test-failure/error e [name #f])
   (parameterize ((current-output-port (current-error-port)))
     (display-delimiter)
@@ -103,7 +107,7 @@
            (when #t
              (parameterize ((error-print-context-length 0))
                ((error-display-handler) (exn-message e) e)))]
-          [(exn? e)
+          [else
            (display-error) (newline)
            (display-exn e)])
     (display-delimiter)))
diff --git a/collects/rackunit/private/test-case.rkt b/collects/rackunit/private/test-case.rkt
index 15f226c343..3a4577fc9a 100644
--- a/collects/rackunit/private/test-case.rkt
+++ b/collects/rackunit/private/test-case.rkt
@@ -28,10 +28,10 @@
 ;;
 ;; Run a test-case immediately, printing information on failure
 (define (default-test-case-around thunk)
-  (with-handlers ([exn? default-test-case-handler])
+  (with-handlers ([(lambda (e) #t) default-test-case-handler])
     (thunk)))
 
-;; default-test-case-handler : exn -> any
+;; default-test-case-handler : any -> any
 (define (default-test-case-handler e)
   (display-test-failure/error e (current-test-name)))
 
diff --git a/collects/rackunit/text-ui.rkt b/collects/rackunit/text-ui.rkt
index 13fe982078..89d78f0587 100644
--- a/collects/rackunit/text-ui.rkt
+++ b/collects/rackunit/text-ui.rkt
@@ -108,7 +108,8 @@
          ((error-display-handler) (exn-message exn) exn)))]
     [(test-error? result)
      (let ([exn (test-error-result result)])
-       (textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn)))
+       (when (exn? exn)
+         (textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn))))
        (display-exn exn))]
     [else (void)]))