Adjust docs on checks and current-check-handler

The description of how checks work was misleading since the
exception is usually not raised outside of the check call.

Also the default value for `current-check-handler` was described
incorrectly.

(cherry picked from commit a3a22d191f)

rackunit-doc/rackunit/scribblings/check.scrbl

@@ -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 a true value if it is a function, or
+@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

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 expr-1 expr-2 ...)]{
+@defform[(before before-expr expr1 expr2 ...)]{
 
 Whenever control enters the scope execute the @racket[before-expr]
 before executing @racket[expr-1], and @racket[expr-2 ...]}

rackunit-doc/rackunit/scribblings/ui.scrbl

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

rackunit-lib/info.rkt

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

rackunit-lib/rackunit/private/check.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
 (require racket/match
-         (for-syntax racket/base)
+         (for-syntax racket/base
+                     "location.rkt")
          rackunit/log
          "base.rkt"
          "check-info.rkt"
@@ -144,18 +145,19 @@
            (define check-secret-name check-fn)
            
            (define-syntax (name stx)
-             (with-syntax ([loc (datum->syntax #f 'loc stx)])
+             (with-syntax
+                 ([loc (syntax->location stx)])
                (syntax-case stx ()
                  ((name actual ...)
                   (syntax/loc stx
                     (check-secret-name actual ...
-                                       #:location (syntax->location (quote-syntax loc))
+                                       #:location (quote loc)
                                        #:expression (quote (name actual ...)))))
 
                  ((name actual ... msg)
                   (syntax/loc stx
                     (check-secret-name actual ... msg
-                                       #:location (syntax->location (quote-syntax loc))
+                                       #:location (quote loc)
                                        #:expression (quote (name actual ...)))))
                     
                  (name
@@ -164,11 +166,11 @@
                     (case-lambda
                       [(formal ...)
                        (check-secret-name formal ... 
-                                          #:location (syntax->location (quote-syntax loc))
+                                          #:location (quote loc) 
                                           #:expression (quote (name actual ...)))]
                       [(formal ... msg)
                        (check-secret-name formal ... msg
-                                          #:location (syntax->location (quote-syntax loc))
+                                          #:location (quote loc) 
                                           #:expression (quote (name actual ...)))]))))))
            ))))))
 
@@ -215,7 +217,7 @@
                [(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1))
                 raw-pred]
                [else
-                (raise-argument-error 'check-exn "(or/c (-> any/c any/c) regexp?)" raw-pred)])])
+                (raise-argument-error 'check-exn "(-> any/c any/c)" raw-pred)])])
     (raise-error-if-not-thunk 'check-exn thunk)
     (let/ec succeed
       (with-handlers
@@ -305,7 +307,11 @@
        (with-check-info*
         (list (make-check-name 'check-match)
               (make-check-location
-               (syntax->location (quote-syntax #,(datum->syntax #f 'loc stx))))
+               (list '(unsyntax (syntax-source 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,9 +1,7 @@
 #lang racket/base
 (require racket/match
          "base.rkt"
-         "check-info.rkt"
-         "text-ui-util.rkt"
-         "location.rkt")
+         "check-info.rkt")
 
 (provide display-check-info-name-value
          display-check-info
@@ -17,10 +15,7 @@
 
          display-test-failure/error
          strip-redundant-params
-         check-info-stack-max-name-width
-
-         display-verbose-check-info
-         sort-stack)
+         check-info-stack-max-name-width)
 
 ;; name-width : integer
 ;;
@@ -61,38 +56,6 @@
     [(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
@@ -100,8 +63,11 @@
 
 ;; display-check-info-stack : (listof check-info) -> void
 (define (display-check-info-stack check-info-stack)
-  (display-verbose-check-info-stack
-   (strip-redundant-params check-info-stack))
+  (define max-name-width (check-info-stack-max-name-width check-info-stack))
+  (define (display-check-info-with-width check-info)
+    (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
@@ -165,21 +131,3 @@
            (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,9 +1,7 @@
 #lang racket/base
 (require (for-syntax racket/base)
          racket/contract/base
-         rackunit/log
          "format.rkt"
-         "base.rkt"
          "check.rkt")
 
 (provide current-test-name
@@ -28,7 +26,7 @@
 ;;
 ;; Run a test-case immediately, printing information on failure
 (define (default-test-case-around thunk)
-  (with-handlers ([(lambda (e) (not (exn:break? e))) default-test-case-handler])
+  (with-handlers ([(lambda (e) #t) default-test-case-handler])
     (parameterize ((current-custodian (make-custodian)))
       (thunk))))
 
@@ -50,17 +48,11 @@
      (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
@@ -72,15 +64,12 @@
     [(_ name expr ...)
      (quasisyntax/loc stx
        (parameterize
-           ([current-test-name
-             (ensure-string name (quote-syntax #,(datum->syntax #f 'loc #'name)))])
+           ([current-test-name 
+             (contract string? 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,6 +111,24 @@
        (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
@@ -154,6 +172,31 @@
       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

@@ -1,38 +0,0 @@
-#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,10 +47,9 @@ Outta here!
 --------------------
 FAILURE
 name:       check
-location:   standalone-check-test.rkt:48:0
-params:     (#<procedure:=> 1 2)
+location:   (#<path:PLTHOME/collects/tests/rackunit/standalone-check-test.rkt> 48 0 1450 17)
 expression: (check = 1 2)
-message:    0.0
+params:     (#<procedure:=> 1 2)\nmessage:    0.0
 
 Check failure
 --------------------
@@ -72,10 +71,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
@@ -83,10 +82,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

@@ -1,10 +0,0 @@
-#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))