Use define-runtime-path for the rackunit screenshot.

a failed test

or, in other words, make a top-level check-equal? more like a
check-equal? inside a test-suite that runs in verbose mode

(except that a top-level one limits the output to error-print-width
 characters, but the one inside a test-suite doesn't seem to do that)

rackunit-doc/rackunit/scribblings/check.scrbl

@@ -10,10 +10,10 @@
 @title{Checks}
 
 Checks are the basic building block of RackUnit.  A check
-checks some condition.  If the condition holds the check
+checks some condition and always
-evaluates to @racket[(void)].  If the condition doesn't hold the
+evaluates to @racket[(void)].  If the condition doesn't hold, the
-check raises an instance of @racket[exn:test:check] with
+check will report the failure (see @racket[current-check-handler]
-information detailing the failure.
+for customizing how failures are handled).
 
 Although checks are implemented as macros, which is
 necessary to grab source location, they are conceptually
@@ -109,7 +109,7 @@ For example, the following checks all fail:
          void?]{
 
 Checks that @racket[thunk] raises an exception and that either
-@racket[exn-predicate] returns @racket[#t] if it is a function, or
+@racket[exn-predicate] returns a true value 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

rackunit-doc/rackunit/scribblings/compound-testing.scrbl

@@ -122,7 +122,7 @@ finished.
     (check-eq? 1 1))
   (test-suite "A nested test suite"
     (test-case "Another test"
-      (check-< 1 2))))
+      (check < 1 2))))
 ]
 
 @defproc[(make-test-suite [name string?]

rackunit-doc/rackunit/scribblings/control-flow.scrbl

@@ -7,7 +7,7 @@ The @racket[before], @racket[after], and @racket[around]
 macros allow you to specify code that is always run before,
 after, or around expressions in a test case.
 
-@defform[(before before-expr expr1 expr2 ...)]{
+@defform[(before before-expr expr-1 expr-2 ...)]{
 
 Whenever control enters the scope execute the @racket[before-expr]
 before executing @racket[expr-1], and @racket[expr-2 ...]}

rackunit-doc/rackunit/scribblings/internals.scrbl

@@ -20,7 +20,8 @@ of these parameters.
 @defparam[current-check-handler handler (-> any/c any)]{
 
 Parameter containing the function that handles exceptions
-raised by check failures.  The default value is @racket[raise].
+raised by check failures.  The default value is a procedure
+that will display the exception data in a user-friendly format.
 }
 
 @defparam[current-check-around check (-> (-> any) any)]{

rackunit-doc/rackunit/scribblings/ui.scrbl

@@ -38,6 +38,8 @@ information.
 RackUnit also provides a GUI test runner, available from the
 @racketmodname[rackunit/gui] module.
 
+@define-runtime-path[scribblings/rackunit-screen-shot.png
+                     "scribblings/rackunit-screen-shot.png"]
 @defproc[(test/gui [test (or/c test-case? test-suite?)] ...
                    [#:wait? wait? boolean? #f])
          void?]{
@@ -47,6 +49,29 @@ GUI is updated as tests complete.
 
 When @racket[wait?] is true, @racket[test/gui] does not return until
 the test runner window has been closed.
+
+ Given the following program, the RackUnit GUI will look as shown below:
+
+ @racketblock[
+ #,(hash-lang) racket
+ (require rackunit rackunit/gui)
+ (test/gui
+  (test-suite
+   "all tests"
+   (test-suite
+    "math tests"
+    (test-case "addition" (check-equal? (+ 1 1) 2))
+    (test-case "subtraction" (check-equal? (- 0 0) 0))
+    (test-case "multiplication" (check-equal? (* 2 2) 5)))
+   (test-suite
+    "string tests"
+    (test-case "append" (check-equal? (string-append "a" "b") "ab"))
+    (test-case "ref" (check-equal? (string-ref "abc" 1) #\b)))))]
+
+ @image[scribblings/rackunit-screen-shot.png]{Screenshot of the RackUnit
+  window. It features a tree representing the nested test suites (with test
+  cases as leaves) on the left pane, and information about the selected test
+  failure in the right pane.}
 }
 
 @defproc[(make-gui-runner)

rackunit-doc/rackunit/scribblings/utils.scrbl

@@ -48,11 +48,12 @@ then the test is considered a failure.
 
 @defproc[(test-log [#:display? display? boolean? #t]
                    [#:exit? exit? boolean? #t])
-         void?]{
+         (cons/c exact-nonnegative-integer?
+                 exact-nonnegative-integer?)]{
 
-Processes the running test log. If @racket[display?] is true, then a
+Processes the running test log. The first integer is the failed tests, the second is the total
-message is displayed. If there were failures, the message is printed
+tests. If @racket[display?] is true, then a message is displayed. If there were failures, the
-on @racket[(current-error-port)]. If @racket[exit?] is true, then if
+message is printed on @racket[(current-error-port)]. If @racket[exit?] is true, then if there were
-there were failures, calls @racket[(exit 1)].
+failures, calls @racket[(exit 1)].
 
 }

rackunit-lib/info.rkt

@@ -3,7 +3,10 @@
 (define collection 'multi)
 
 (define deps '("base"
-               "data-lib"))
+               "data-lib"
+               "testing-util-lib"))
+
+(define implies '("testing-util-lib"))
 
 (define pkg-desc "RackUnit testing framework")
 

rackunit-lib/rackunit/private/check.rkt

@@ -1,8 +1,7 @@
 #lang racket/base
 
 (require racket/match
-         (for-syntax racket/base
+         (for-syntax racket/base)
-                     "location.rkt")
          rackunit/log
          "base.rkt"
          "check-info.rkt"
@@ -145,19 +144,18 @@
            (define check-secret-name check-fn)
            
            (define-syntax (name stx)
-             (with-syntax
+             (with-syntax ([loc (datum->syntax #f 'loc stx)])
-                 ([loc (syntax->location stx)])
                (syntax-case stx ()
                  ((name actual ...)
                   (syntax/loc stx
                     (check-secret-name actual ...
-                                       #:location (quote loc)
+                                       #:location (syntax->location (quote-syntax loc))
                                        #:expression (quote (name actual ...)))))
 
                  ((name actual ... msg)
                   (syntax/loc stx
                     (check-secret-name actual ... msg
-                                       #:location (quote loc)
+                                       #:location (syntax->location (quote-syntax loc))
                                        #:expression (quote (name actual ...)))))
                     
                  (name
@@ -166,11 +164,11 @@
                     (case-lambda
                       [(formal ...)
                        (check-secret-name formal ... 
-                                          #:location (quote loc) 
+                                          #:location (syntax->location (quote-syntax loc))
                                           #:expression (quote (name actual ...)))]
                       [(formal ... msg)
                        (check-secret-name formal ... msg
-                                          #:location (quote loc) 
+                                          #:location (syntax->location (quote-syntax loc))
                                           #:expression (quote (name actual ...)))]))))))
            ))))))
 
@@ -217,7 +215,7 @@
                [(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1))
                 raw-pred]
                [else
-                (raise-argument-error 'check-exn "(-> any/c any/c)" raw-pred)])])
+                (raise-argument-error 'check-exn "(or/c (-> any/c any/c) regexp?)" raw-pred)])])
     (raise-error-if-not-thunk 'check-exn thunk)
     (let/ec succeed
       (with-handlers
@@ -307,11 +305,7 @@
        (with-check-info*
         (list (make-check-name 'check-match)
               (make-check-location
-               (list '(unsyntax (syntax-source stx))
+               (syntax->location (quote-syntax #,(datum->syntax #f 'loc stx))))
-                     '(unsyntax (syntax-line stx))
-                     '(unsyntax (syntax-column stx))
-                     '(unsyntax (syntax-position stx))
-                     '(unsyntax (syntax-span stx))))
               (make-check-expression '#,(syntax->datum stx))
               (make-check-actual actual-val)
               (make-check-expected 'expected))

rackunit-lib/rackunit/private/format.rkt

@@ -1,7 +1,9 @@
 #lang racket/base
 (require racket/match
          "base.rkt"
-         "check-info.rkt")
+         "check-info.rkt"
+         "text-ui-util.rkt"
+         "location.rkt")
 
 (provide display-check-info-name-value
          display-check-info
@@ -15,7 +17,10 @@
 
          display-test-failure/error
          strip-redundant-params
-         check-info-stack-max-name-width)
+         check-info-stack-max-name-width
+
+         display-verbose-check-info
+         sort-stack)
 
 ;; name-width : integer
 ;;
@@ -56,6 +61,38 @@
     [(struct check-info (name value))
      (display-check-info-name-value max-name-width name value)]))
 
+;; display-verbose-check-info : test-result -> void
+(define (display-verbose-check-info result)
+  (cond
+    ((test-failure? result)
+     (let* ((exn (test-failure-result result))
+            (stack (exn:test:check-stack exn)))
+       (display-verbose-check-info-stack check-info-stack)))
+    ((test-error? result)
+     (display-exn (test-error-result result)))
+    (else
+     (void))))
+
+(define (display-verbose-check-info-stack check-info-stack)
+  (define max-name-width (check-info-stack-max-name-width check-info-stack))
+  (for ([info (in-list (sort-stack check-info-stack))])
+    (cond
+      ((check-location? info)
+       (display-check-info-name-value max-name-width
+                                      'location
+                                      (trim-current-directory
+                                       (location->string
+                                        (check-info-value info)))
+                                      (λ (x) (printf "~a\n" x))))
+      ((check-expression? info)
+       (display-check-info-name-value max-name-width
+                                      (check-info-name info)
+                                      (check-info-value info)
+                                      (λ (x) (printf "~.s\n" x))))
+      (else
+       (display-check-info-name-value max-name-width
+                                      (check-info-name info)
+                                      (check-info-value info))))))
 
 (define (check-info-stack-max-name-width check-info-stack)
   (apply max 0
@@ -63,11 +100,8 @@
 
 ;; display-check-info-stack : (listof check-info) -> void
 (define (display-check-info-stack check-info-stack)
-  (define max-name-width (check-info-stack-max-name-width check-info-stack))
+  (display-verbose-check-info-stack
-  (define (display-check-info-with-width check-info)
+   (strip-redundant-params check-info-stack))
-    (display-check-info max-name-width check-info))
-  (for-each display-check-info-with-width
-            (strip-redundant-params check-info-stack))
   (newline))
 
 ;; display-test-name : (U string #f) -> void
@@ -131,3 +165,21 @@
            (display-error) (newline)
            (display-exn e)])
     (display-delimiter)))
+
+(define (sort-stack l)
+  (sort l <
+        #:key 
+        (λ (info)
+          (cond
+            [(check-name? info)
+             0]
+            [(check-location? info)
+             1]
+            [(check-params? info)
+             2]
+            [(check-actual? info)
+             3]
+            [(check-expected? info)
+             4]
+            [else
+             5]))))

rackunit-lib/rackunit/private/test-case.rkt

@@ -1,7 +1,9 @@
 #lang racket/base
 (require (for-syntax racket/base)
          racket/contract/base
+         rackunit/log
          "format.rkt"
+         "base.rkt"
          "check.rkt")
 
 (provide current-test-name
@@ -26,7 +28,7 @@
 ;;
 ;; Run a test-case immediately, printing information on failure
 (define (default-test-case-around thunk)
-  (with-handlers ([(lambda (e) #t) default-test-case-handler])
+  (with-handlers ([(lambda (e) (not (exn:break? e))) default-test-case-handler])
     (parameterize ((current-custodian (make-custodian)))
       (thunk))))
 
@@ -48,11 +50,17 @@
      (syntax/loc stx
        ((current-test-case-around)
         (lambda ()
+          (with-handlers ([(λ (e)
+                             (and (exn:fail? e)
+                                  (not (exn:test? e))))
+                           (λ (e)
+                             (test-log! #f)
+                             (raise e))])
           (parameterize
               ([current-check-handler raise]
                [current-check-around  check-around])
             (void)
-            expr ...))))]
+            expr ...)))))]
     [_
      (raise-syntax-error
       #f
@@ -64,12 +72,15 @@
     [(_ name expr ...)
      (quasisyntax/loc stx
        (parameterize
-           ([current-test-name 
+           ([current-test-name
-             (contract string? name 
+             (ensure-string name (quote-syntax #,(datum->syntax #f 'loc #'name)))])
-                       '#,(syntax-source-module #'name #t)
-                       '#,(syntax-source-module #'test-case #t))])
          (test-begin expr ...)))]))
 
+(define (ensure-string name src-stx)
+  (contract string? name
+            (syntax-source src-stx)
+            (syntax-source-module #'test-case #t)))
+
 (define-syntax before
   (syntax-rules ()
     ((_ before-e expr1 expr2 ...)

rackunit-lib/rackunit/text-ui.rkt

@@ -111,24 +111,6 @@
        (display-exn exn))]
     [else (void)]))
 
-(define (sort-stack l)
-  (sort l < 
-        #:key 
-        (λ (info)
-          (cond
-            [(check-name? info)
-             0]
-            [(check-location? info)
-             1]
-            [(check-params? info)
-             2]
-            [(check-actual? info)
-             3]
-            [(check-expected? info)
-             4]            
-            [else
-             5]))))
-
 (define (textui-display-check-info-stack stack [verbose? #f])
   (define max-name-width (check-info-stack-max-name-width stack))
   (for-each
@@ -172,31 +154,6 @@
       stack
       (strip-redundant-params stack)))))
 
-;; display-verbose-check-info : test-result -> void
-(define (display-verbose-check-info result)
-  (cond
-    ((test-failure? result)
-     (let* ((exn (test-failure-result result))
-            (stack (exn:test:check-stack exn)))
-       (for-each
-        (lambda (info)
-          (cond
-            ((check-location? info)
-             (display "location: ")
-             (display (trim-current-directory
-                       (location->string
-                        (check-info-value info)))))
-            (else
-             (display (check-info-name info))
-             (display ": ")
-             (write (check-info-value info))))
-          (newline))
-        (sort-stack stack))))
-    ((test-error? result)
-     (display-exn (test-error-result result)))
-    (else
-     (void))))
-
 (define (std-test/text-ui display-context test)
   (fold-test-results
    (lambda (result seed)

rackunit-test/tests/rackunit/pr/13.rkt

@@ -0,0 +1,38 @@
+#lang racket/base
+(require rackunit
+         rackunit/text-ui
+         racket/port
+         racket/match
+         racket/system
+         racket/runtime-path)
+
+(define-runtime-path me "13.rkt")
+
+(define a
+  (test-suite "Test Suite"
+              (test-case "Test Case"
+                (check-equal? #t #f))))
+
+(define b
+  (test-suite "Test Suite"
+              (test-case "Test Case"
+                (check-equal? (error 'error "I'm an error!") #f))))
+
+(module+ test
+  (define mode (getenv "PR13"))
+  (printf "\n\nRunning in mode ~v\n\n" mode)
+  (match mode
+    ["a" (run-tests a)]
+    ["a-raw" (check-equal? #t #f)]
+    ["b" (run-tests b)]
+    ["b-raw" (check-equal? (error 'error "I'm an error!") #f)]
+    [#f
+     (for ([v (in-list '("a" "a-raw" "b" "b-raw"))])
+       (putenv "PR13" v)
+       (printf "Readying mode ~v\n" v)
+       (check-equal?
+        (parameterize ([current-output-port (open-output-nowhere)])
+          (parameterize ([current-error-port (current-output-port)])
+            (system*/exit-code (find-system-path 'exec-file)
+                               "-l" "raco" "--" "test" me)))
+        1))]))

rackunit-test/tests/rackunit/standalone.rkt

@@ -47,9 +47,10 @@ Outta here!
 --------------------
 FAILURE
 name:       check
-location:   (#<path:PLTHOME/collects/tests/rackunit/standalone-check-test.rkt> 48 0 1450 17)
+location:   standalone-check-test.rkt:48:0
+params:     (#<procedure:=> 1 2)
 expression: (check = 1 2)
-params:     (#<procedure:=> 1 2)\nmessage:    0.0
+message:    0.0
 
 Check failure
 --------------------
@@ -71,10 +72,10 @@ Second Outta here!
 --------------------
 --------------------
 FAILURE
+name:       check-eq?
+location:   standalone-test-case-test.rkt:23:12
 actual:     1
 expected:   2
-name:       check-eq?
-location:   (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 23 12 626 15)
 expression: (check-eq? 1 2)
 
 Check failure
@@ -82,10 +83,10 @@ Check failure
 --------------------
 failure
 FAILURE
+name:       check-eq?
+location:   standalone-test-case-test.rkt:24:21
 actual:     1
 expected:   2
-name:       check-eq?
-location:   (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 24 21 664 15)
 expression: (check-eq? 1 2)
 
 Check failure

testing-util-lib/info.rkt

@@ -0,0 +1,10 @@
+#lang info
+(define collection 'multi)
+
+(define deps '("base"))
+
+(define pkg-desc "Utilities for interoperating between testing frameworks")
+
+(define version "1.0")
+
+(define pkg-authors '(florence))