fixed race in rackunit gui

Merge to release branch

original commit: 9d42ef9235e40de846fc480d6fcd13fa0f00a929

collects/rackunit/private/check-info.rkt

@@ -24,7 +24,11 @@
 
 ;; (continuation-mark-set -> (listof check-info))
 (define (check-info-stack marks)
-  (apply append (continuation-mark-set->list marks check-info-mark)))
+  (let ([ht (make-hash)])
+    (for ([x (in-list (apply append (continuation-mark-set->list marks check-info-mark)))]
+          [i (in-naturals)])
+      (hash-set! ht (check-info-name x) (cons i x)))
+    (map cdr (sort (hash-map ht (λ (k v) v)) < #:key car))))
 
 ;; with-check-info* : (list-of check-info) thunk -> any
 (define (with-check-info* info thunk)

collects/rackunit/private/check.rkt

@@ -2,7 +2,6 @@
 
 (require (for-syntax racket/base
                      "location.rkt")
-         srfi/1
          "base.rkt"
          "check-info.rkt"
          "format.rkt"
@@ -34,39 +33,50 @@
          check-not-equal?
          fail)
 
+
+(define USE-ERROR-HANDLER? #f)
+
+;; default-check-handler : exn -> any
+(define (default-check-handler e)
+  (let ([out (open-output-string)])
+    ;;(display "check failed\n" out)
+    (parameterize ((current-output-port out))
+      (display-delimiter)
+      (cond [(exn:test:check? e)
+             (display-failure)
+             (newline)
+             (display-check-info-stack
+              (exn:test:check-stack e))]
+            [(exn? e)
+             (display-error)
+             (newline)
+             (display-exn e)])
+      (display-delimiter))
+    (cond [USE-ERROR-HANDLER?
+           ((error-display-handler) (get-output-string out)
+            ;; So that DrRacket won't recognize exn:fail:syntax, etc
+            (make-exn (exn-message exn) (exn-continuation-marks exn)))]
+          [else
+           (display (get-output-string out) (current-error-port))])))
+
 ;; parameter current-check-handler : (-> exn any)
 (define current-check-handler
   (make-parameter
-   (lambda (e)
+   default-check-handler
-     (cond
-      [(exn:test:check? e)
-       (display-delimiter)
-       (display-failure)(newline)
-       (display-check-info-stack
-        (exn:test:check-stack e))
-       (display-delimiter)]
-      [(exn? e)
-       (display-delimiter)
-       (display-error)(newline)
-       (display-exn e)
-       (display-delimiter)]))
    (lambda (v)
      (if (procedure? v)
          v
          (raise-type-error 'current-check-handler "procedure" v)))))
 
 ;; check-around : ( -> a) -> a
-(define check-around
+(define (check-around thunk)
-  (lambda (thunk)
+  (with-handlers ([exn? (current-check-handler)])
-    (with-handlers
+    (thunk)))
-        ([exn? (current-check-handler)])
-      (thunk))))
 
 ;; top-level-check-around : ( -> a) -> a
-(define top-level-check-around
+(define (top-level-check-around thunk)
-  (lambda (thunk)
   (check-around thunk)
-    (void)))
+  (void))
 
 ;; parameter current-check-around : (( -> a) -> a)
 (define current-check-around
@@ -161,7 +171,15 @@
                  (name
                   (identifier? #'name)
                   (syntax/loc stx
-                    check-secret-name)))))
+                    (case-lambda
+                      [(formal ...)
+                       (check-secret-name formal ... 
+                                          #:location (quote loc) 
+                                          #:expression (quote (name actual ...)))]
+                      [(formal ... msg)
+                       (check-secret-name formal ... msg
+                                          #:location (quote loc) 
+                                          #:expression (quote (name actual ...)))]))))))
            ))))))
 
 (define-syntax define-simple-check
@@ -195,7 +213,10 @@
               #t
               (fail-check)))))]))
 
-(define-check (check-exn pred thunk)
+(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
@@ -220,7 +241,7 @@
         (thunk))
       (with-check-info*
        (list (make-check-message "No exception raised"))
-     (lambda () (fail-check)))))
+       (lambda () (fail-check))))))
 
 (define-check (check-not-exn thunk)
   (with-handlers

collects/rackunit/private/gui/gui.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require racket/class
          unstable/class-iop
-         racket/gui
+         racket/gui/base
          "../base.rkt"
          "../result.rkt"
          "../check-info.rkt"

collects/rackunit/private/gui/model.rkt

@@ -2,7 +2,7 @@
 (require racket/class
          unstable/class-iop
          racket/list
-         "gvector.rkt"
+         data/gvector
          "../base.rkt"
          "interfaces.rkt"
          "cache-box.rkt")

collects/rackunit/private/gui/model2rml.rkt

@@ -2,9 +2,10 @@
 (require racket/class
          unstable/class-iop
          racket/list
-         racket/gui
+         racket/gui/base
          racket/match
          racket/file
+         racket/path
          mrlib/include-bitmap
          (prefix-in drlink: "drracket-ui.rkt")
          "interfaces.rkt"

collects/rackunit/private/gui/rml.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 (require racket/class
          unstable/class-iop
-         racket/gui
+         racket/gui/base
          framework
          "interfaces.rkt")
 

collects/rackunit/private/gui/view.rkt

@@ -3,7 +3,7 @@
          unstable/class-iop
          unstable/gui/notify
          racket/list
-         racket/gui
+         racket/gui/base
          framework
          mrlib/hierlist
          "interfaces.rkt"
@@ -71,8 +71,16 @@ still be there, just not visible?
            (view this)
            (controller controller)))
 
-    ;; for update management
+    ;; Update management
-    (define update-queue (make-hasheq))
+    ;; Do adds in order, then updates in any order (hash).
+
+    ;; add-queue : (listof (-> void))
+    (define add-queue null)
+
+    ;; update-queue : (imm-hashof model<%> #t)
+    (define update-queue '#hasheq())
+
+    ;; update-lock : semaphore
     (define update-lock (make-semaphore 1))
 
     (send editor lock #t)
@@ -83,12 +91,6 @@ still be there, just not visible?
 
     ;; View Links
 
-    (define/public (create-view-link model parent)
-      (parameterize ((current-eventspace eventspace))
-        (queue-callback
-         (lambda ()
-           (send tree-view create-view-link model parent)))))
-
     (define/private (get-view-link model)
       (send tree-view get-view-link model))
 
@@ -108,10 +110,18 @@ still be there, just not visible?
 
     ;; Update Management
 
+    ;; create-view-link : model suite-result<%>/#f -> void
+    (define/public (create-view-link model parent)
+      (let ([proc (lambda () (send tree-view create-view-link model parent))])
+        (semaphore-wait update-lock)
+        (set! add-queue (cons proc add-queue))
+        (semaphore-post update-lock)
+        (process-updates)))
+
     ;; queue-for-update : model -> void
     (define/public (queue-for-update model)
       (semaphore-wait update-lock)
-      (hash-set! update-queue model #t)
+      (set! update-queue (hash-set update-queue model #t))
       (semaphore-post update-lock)
       (process-updates))
 
@@ -120,38 +130,33 @@ still be there, just not visible?
       (parameterize ((current-eventspace eventspace))
         (queue-callback
          (lambda ()
-           (let ([models-to-update (grab+clear-update-queue)])
+           (let-values ([(adds updates) (grab+clear-update-queue)])
-             (for ([model models-to-update])
+             (for ([add (in-list adds)])
+               (add))
+             (for ([model (in-hash-keys updates)])
                (do-model-update model)))))))
 
-    ;; grab+clear-update-queue : -> void
+    ;; grab+clear-update-queue : -> (values list hash)
     ;; ** Must be called from eventspace thread.
     (define/private (grab+clear-update-queue)
       (semaphore-wait update-lock)
-      (if (positive? (hash-count update-queue))
+      (begin0
-          (let ([old-queue update-queue])
+          (values (reverse add-queue)
-            (set! update-queue (make-hasheq))
+                  update-queue)
-            (semaphore-post update-lock)
+        (set! add-queue null)
-            (reverse
+        (set! update-queue '#hasheq())
-             (hash-map old-queue (lambda (k v) k))))
+        (semaphore-post update-lock)))
-          (begin (semaphore-post update-lock)
-                 null)))
 
     ;; do-model-update : model<%> -> void
     ;; ** Must be called from eventspace thread.
     (define/private (do-model-update model)
       (let ([view-link (get-view-link model)])
-        (cond [view-link
+        (unless view-link
+          ;; should not be possible
+          (error 'rackunit-gui "internal error: no view-link"))
         (send tree-view update-item view-link)
         (when (eq? model (get-selected-model))
-                 (show-model model))]
+          (show-model model))))
-              [(not view-link)
-               ;; If the view-link has not been created,
-               ;; yield until it is.
-               (unless (yield)
-                 (error 'rackunit-gui
-                        "internal error: no progress waiting for view-link"))
-               (do-model-update model)])))
 
     ;; Update display
 

collects/rackunit/private/test-case.rkt

@@ -16,42 +16,47 @@
          after
          around)
 
+(define USE-ERROR-HANDLER? #f)
+
 (define current-test-name
   (make-parameter
    #f
    (lambda (v)
      (if (string? v)
          v
-         (raise-mismatch-error
+         (raise-type-error 'current-test-name "string" v)))))
-          'current-test-name
-          "string?"
-          v)))))
 
 ;; test-case-around : ( -> a) -> a
 ;;
 ;; Run a test-case immediately, printing information on failure
-(define test-case-around
+(define (default-test-case-around thunk)
-  (lambda (thunk)
+  (with-handlers ([exn? default-test-case-handler])
-    (with-handlers
+    (thunk)))
-        ([exn:test:check?
+
-          (lambda (e)
+;; default-test-case-handler : exn -> any
+(define (default-test-case-handler e)
+  (let ([out (open-output-string)])
+    ;;(display "test case failed\n" out)
+    (parameterize ((current-output-port out))
       (display-delimiter)
       (display-test-name (current-test-name))
+      (cond [(exn:test:check? e)
              (display-failure)(newline)
-            (display-check-info-stack (exn:test:check-stack e))
+             (display-check-info-stack (exn:test:check-stack e))]
-            (display-delimiter))]
+            [(exn? e)
-         [exn?
-          (lambda (e)
-            (display-delimiter)
-            (display-test-name (current-test-name))
              (display-error)(newline)
-            (display-exn e)
+             (display-exn e)])
-            (display-delimiter))])
+      (display-delimiter))
-      (thunk))))
+    (cond [USE-ERROR-HANDLER?
+           ((error-display-handler) (get-output-string out)
+            ;; So that DrRacket won't recognize exn:fail:syntax, etc
+            (make-exn (exn-message e) (exn-continuation-marks e)))]
+          [else
+           (display (get-output-string out) (current-error-port))])))
 
 (define current-test-case-around
   (make-parameter
-   test-case-around
+   default-test-case-around
    (lambda (v)
      (if (procedure? v)
          v
@@ -66,6 +71,7 @@
           (parameterize
               ([current-check-handler raise]
                [current-check-around  check-around])
+            (void)
             expr ...))))]
     [_
      (raise-syntax-error
@@ -73,7 +79,6 @@
       "Correct form is (test-begin expr ...)"
       stx)]))
 
-  
 (define-syntax test-case
   (syntax-rules ()
     [(test-case name expr ...)
@@ -81,7 +86,6 @@
          ([current-test-name name])
        (test-begin expr ...))]))
 
-  
 (define-syntax before
   (syntax-rules ()
     ((_ before-e expr1 expr2 ...)
@@ -132,4 +136,3 @@
       "Incorrect use of around macro.  Correct format is (around before-expr expr1 expr2 ... after-expr)"
       'around
       '(error ...)))))
-

collects/rackunit/scribblings/api.scrbl

@@ -12,6 +12,3 @@
 @include-section["control-flow.scrbl"]
 @include-section["misc.scrbl"]
 @include-section["ui.scrbl"]
-@include-section["running-tests.scrbl"]
-
-

collects/rackunit/scribblings/check.scrbl

@@ -5,7 +5,7 @@
 
 Checks are the basic building block of RackUnit.  A check
 checks some condition.  If the condition holds the check
-evaluates to @racket[#t].  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
 information detailing the failure.
 
@@ -19,75 +19,74 @@ source locations if you do so.
 The following are the basic checks RackUnit provides.  You
 can create your own checks using @racket[define-check].
 
-@defproc[(check (op (-> any any any))
+@defproc*[([(check-eq? (v1 any) (v2 any) (message string? "")) void?]
-                (v1 any)
+           [(check-not-eq? (v1 any) (v2 any) (message string? "")) void?]
-                (v2 any)
+           [(check-eqv? (v1 any) (v2 any) (message string? "")) void?]
-		(message string? ""))
+           [(check-not-eqv? (v1 any) (v2 any) (message string? "")) void?]
-         any]{
+           [(check-equal? (v1 any) (v2 any) (message string? "")) void?]
+           [(check-not-equal? (v1 any) (v2 any) (message string? "")) void?])]{
 
-The simplest check.  Succeeds if @racket[op] applied to @racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an exception of type @racket[exn:test:check].  The optional @racket[message] is included in the output if the check fails. If the check succeeds, the value returned by @racket[op] is the value returned by the check.}
+Checks that @racket[v1] is equal (or not equal) to @racket[v2], using
-
+@racket[eq?], @racket[eqv?], or @racket[equal?], respectively. The
-For example, the following check succeeds:
+optional @racket[message] is included in the output if the check
-
+fails.
-@racketblock[
-  (check < 2 3)
-]
-
-@defproc*[([(check-eq? (v1 any) (v2 any) (message string? "")) #t]
-           [(check-not-eq? (v1 any) (v2 any) (message string? "")) #t]
-           [(check-eqv? (v1 any) (v2 any) (message string? "")) #t]
-           [(check-not-eqv? (v1 any) (v2 any) (message string? "")) #t]
-           [(check-equal? (v1 any) (v2 any) (message string? "")) #t]
-           [(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{
-
-Checks that @racket[v1] is (not) @racket[eq?],
-@racket[eqv?], or @racket[equal?] to @racket[v2]. The
-optional @racket[message] is included in the output if the
-check fails.}
 
 For example, the following checks all fail:
 
 @racketblock[
   (check-eq? (list 1) (list 1) "allocated data not eq?")
-  (check-not-eq? 1 1 "integers are eq?")
+  (check-not-eq? 1 1 "fixnums are eq?")
   (check-eqv? 1 1.0 "not eqv?")
   (check-not-eqv? 1 1 "integers are eqv?")
   (check-equal? 1 1.0 "not equal?")
   (check-not-equal? (list 1) (list 1) "equal?")
 ]
+}
 
 @defproc[(check-pred (pred (-> any any)) (v any) (message string? ""))
-        #t]{Checks that @racket[pred] returns a value that is not @racket[#f] when applied to @racket[v].  The optional @racket[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @racket[pred].}
+         void?]{
 
-Here's an example that passes and an example that fails:
+Checks that @racket[pred] returns a value that is not @racket[#f] when
+applied to @racket[v].  The optional @racket[message] is included in
+the output if the check fails. The value returned by a successful
+check is the value returned by @racket[pred].
 
+For example, the following check passes:
 @racketblock[
   (check-pred string? "I work")
+]
+The following check fails:
+@racketblock[
   (check-pred number? "I fail")
 ]
+}
 
-
+@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? ""))
-@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{
+         void?]{
 
 Checks that @racket[v1] and @racket[v2] are within
 @racket[epsilon] of one another.  The optional
 @racket[message] is included in the output if the check
-fails.}
+fails.
 
-Here's an example that passes and an example that fails:
+For example, the following check passes:
 
 @racketblock[
   (check-= 1.0 1.01 0.01 "I work")
+]
+The following check fails:
+@racketblock[
   (check-= 1.0 1.01 0.005 "I fail")
 ]
+}
 
-@defproc*[([(check-true (v any) (message string? "")) #t]
+@defproc*[([(check-true (v any) (message string? "")) void?]
-           [(check-false (v any) (message string? "")) #t]
+           [(check-false (v any) (message string? "")) void?]
-           [(check-not-false (v any) (message string? "")) #t])]{
+           [(check-not-false (v any) (message string? "")) void?])]{
 
-Checks that @racket[v] is @racket[#t], @racket[#f], or not
+Checks that @racket[v] is @racket[#t], is @racket[#f], or is not
-@racket[#f] as appropriate.  The optional @racket[message]
+@racket[#f], respectively.  The optional @racket[message] is included
-is included in the output if the check fails.}
+in the output if the check fails.
 
 For example, the following checks all fail:
 
@@ -96,55 +95,112 @@ For example, the following checks all fail:
   (check-false 1)
   (check-not-false #f)
 ]
+}
 
+@defproc[(check-exn (exn-predicate (or/c (-> any boolean?) regexp?))
+                    (thunk (-> any)) (message string? ""))
+         void?]{
 
-@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
+Checks that @racket[thunk] raises an exception and that either
-         #t]{
+@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 checks are conceptually functions.
 
-Checks that @racket[thunk] raises an exception for which
+For example, the following check succeeds:
-@racket[exn-predicate] returns @racket[#t].  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
-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))))
 ]
 
-@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{
+The following check fails:
+
+@racketblock[
+  (check-exn exn:fail?
+             (lambda ()
+               (break-thread (current-thread))))
+]
+
+The following example is a common mistake. The call to @racket[error]
+is not within a @racket[lambda], so it bypasses @racket[check-exn]
+entirely.
+
+@racketblock[
+  (code:comment "Forgot to wrap the expression in a thunk.  Don't do this!")
+  (check-exn exn:fail?
+             (error 'hi "there"))
+]
+}
+
+@defproc[(check-not-exn (thunk (-> any)) (message string? "")) void?]{
 
 Checks that @racket[thunk] does not raise any exceptions.
 The optional @racket[message] is included in the output if
-the check fails.}
+the check fails.
+}
 
-@defproc[(fail (message string? "")) #t]{This checks fails unconditionally.  Good for creating test stubs that youintend to fill out later.  The optional @racket[message] is included in the output if the check fails.}
+@defproc[(check-regexp-match (regexp regexp?)
+                             (string string?))
+         void?]{
+
+Checks that @racket[regexp] matches the @racket[string].
 
 
-@defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @racket[regexp] matches the @racket[string].}
+For example, the following check succeeds:
 
-The following check will succeed:
+@racketblock[
+  (check-regexp-match "a+bba" "aaaaaabba")
+]
 
-@racketblock[(check-regexp-match "a+bba" "aaaaaabba")]
+The following check fails:
 
-This check will fail:
+@racketblock[
-
+  (check-regexp-match "a+bba" "aaaabbba")
-@racketblock[(check-regexp-match "a+bba" "aaaabbba")]
+]
+}
 
 
+@defproc[(check (op (-> any any any))
+                (v1 any)
+                (v2 any)
+		(message string? ""))
+         void?]{
+
+The most generic check.  Succeeds if @racket[op] applied to
+@racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an
+exception of type @racket[exn:test:check].  The optional
+@racket[message] is included in the output if the check fails.
+
+For example, the following check succeeds:
+
+@racketblock[
+  (check < 2 3)
+]
+
+The following check fails:
+
+@racketblock[
+  (check memq 'pine '(apple orange pear))
+]
+}
+
+@defproc[(fail (message string? ""))
+         void?]{
+
+This check fails unconditionally.  Good for creating test stubs that
+you intend to fill out later.  The optional @racket[message] is
+included in the output.
+}
 
 @section{Augmenting Information on Check Failure}
 
-When an check fails it stores information including the name
+When a check fails it stores information including the name
 of the check, the location and message (if available), the
 expression the check is called with, and the parameters to
 the check.  Additional information can be stored by using
@@ -154,7 +210,7 @@ the @racket[with-check-info*] function, and the
 @defstruct[check-info ([name symbol?] [value any])]{
 
 A check-info structure stores information associated
-with the context of execution of an check.}
+with the context of execution of a check.}
 
 The are several predefined functions that create check
 information structures with predefined names.  This avoids
@@ -188,8 +244,7 @@ When this check fails the message
 
 @verbatim{time: <current-seconds-at-time-of-running-check>}
 
-will be printed along with the usual information on an
+is printed along with the usual information on an check failure.
-check failure.
 
 @defform[(with-check-info ((name val) ...) body ...)]{
 
@@ -213,8 +268,7 @@ When this test fails the message
 
 @verbatim{current-element: 8}
 
-will be displayed along with the usual information on an
+is displayed along with the usual information on an check failure.
-check failure.
 
 
 
@@ -229,23 +283,21 @@ Firstly, a check should be considered a function, even
 though most uses are actually macros.  In particular, checks
 always evaluate their arguments exactly once before
 executing any expressions in the body of the checks.  Hence
-if you wish to write checks that evalute user defined code
+if you wish to write checks that evaluate user defined code
 that code must be wrapped in a thunk (a function of no
 arguments) by the user.  The predefined @racket[check-exn]
 is an example of this type of check.
 
-It is also useful to understand how the check information
+It is also useful to understand how the check information stack
-stack operates.  The stack is stored in a parameter and the
+operates.  The stack is stored in a parameter and the
 @racket[with-check-info] forms evaluate to calls to
-@racket[parameterize].  Hence check information has lexical
+@racket[parameterize].  For this reason simple checks (see below)
-scope.  For this reason simple checks (see below) cannot
+cannot usefully contain calls to @racket[with-check-info] to report
-usefully contain calls to @racket[with-check-info] to report
 additional information.  All checks created using
-@racket[define-simple-check] or @racket[define-check] grab
+@racket[define-simple-check] or @racket[define-check] grab some
-some information by default: the name of the checks and the
+information by default: the name of the checks and the values of the
-values of the parameters.  Additionally the macro forms of
+parameters.  Additionally the macro forms of checks grab location
-checks grab location information and the expressions passed
+information and the expressions passed as parameters.
-as parameters.
 
 @defform[(define-simple-check (name param ...) expr ...)]{
 
@@ -257,9 +309,7 @@ check fails if the result of the @racket[expr]s is
 simple checks cannot report extra information using
 @racket[with-check-info].}
 
-Example:
+For example, the following code defines a check @racket[check-odd?]
-
-To define a check @racket[check-odd?]
 
 @racketblock[
   (define-simple-check (check-odd? number)
@@ -308,7 +358,6 @@ tests a number if within 0.01 of the expected value:
     (< (abs (- actual expected)) 0.01))
 ]
 
-
 @defform[(define-check (name param ...) expr ...)]{
 
 The @racket[define-check] macro acts in exactly the same way
@@ -317,29 +366,9 @@ if the macro @racket[fail-check] is called in the body of
 the check.  This allows more flexible checks, and in
 particular more flexible reporting options.}
 
-@defform[(fail-check)]{The @racket[fail-check] macro raises an @racket[exn:test:check] with
+@defform[(fail-check)]{
-the contents of the check information stack.}
 
+The @racket[fail-check] macro raises an @racket[exn:test:check] with
+the contents of the check information stack.
 
-@section{The Check Evaluation Context}
-
-The semantics of checks are determined by the parameters
-@racket[current-check-around] and
-@racket[current-check-handler].  Other testing form such as
-@racket[test-begin] and @racket[test-suite] change the value
-of these parameters.
-
-@defparam[current-check-handler handler (-> any/c any/c)]{
-
-Parameter containing the function that handles exceptions
-raised by check failures.  The default value is @racket[raise].  }
-
-@defparam[current-check-around check (-> thunk any/c)]{
-
-Parameter containing the function that handles the execution
-of checks.  The default value wraps the evaluation of
-@racket[thunk] in a @racket[with-handlers] call that calls
-@racket[current-check-handler] if an exception is raised and then
-(when an exception is not raised) discards the result, returning
-@racket[(void)]. 
 }

collects/rackunit/scribblings/compound-testing.scrbl

@@ -48,9 +48,37 @@ so the test can be named.
 
 
 @defproc[(test-case? (obj any)) boolean?]{
- True if @racket[obj] is a test case, and false otherwise
+ True if @racket[obj] is a test case, and false otherwise.
 }
 
+@subsection{Shortcuts for Defining Test Cases}
+
+@defproc*[([(test-check [name string?]
+                        [operator (-> any/c any/c any/c)]
+                        [v1 any/c]
+                        [v2 any/c])
+            void?]
+           [(test-pred [name string?]
+                       [pred (-> any/c any/c)]
+                       [v any/c])
+            void?]
+           [(test-equal? [name string?] [v1 any/c] [v2 any/c]) (void?)]
+           [(test-eq? [name string?] [v1 any/c] [v2 any/c]) void?]
+           [(test-eqv? [name string?] [v1 any/c] [v2 any/c]) void?]
+           [(test-= [name string?] [v1 real?] [v2 real?] [epsilon real?]) void?]
+           [(test-true [name string?] [v any/c]) void?]
+           [(test-false [name string?] [v any/c]) void?]
+           [(test-not-false [name string?] [v any/c]) void?]
+           [(test-exn [name string?] [pred (-> exn? any/c)] [thunk (-> any)]) void?]
+           [(test-not-exn [name string?] [thunk (-> any)]) void?])]{
+
+Creates a test case with the given @racket[name] that performs the
+corresponding check. For example,
+
+@racketblock[(test-equal? "Fruit test" "apple" "pear")]
+is equivalent to
+@racketblock[(test-case "Fruit test" (check-equal? "apple" "pear"))]
+}
 
 
 @section{Test Suites}
@@ -150,38 +178,3 @@ As far I know no-one uses this macro, so it might disappear
 in future versions of RackUnit.}
 }
 
-
-@section{Compound Testing Evaluation Context}
-
-Just like with checks, there are several parameters that
-control the semantics of compound testing forms.
-
-@defparam[current-test-name name (or/c string? false/c)]{
-
-This parameter stores the name of the current test case.  A
-value of @racket[#f] indicates a test case with no name,
-such as one constructed by @racket[test-begin].  }
-
-@defparam[current-test-case-around handler (-> (-> any/c) any/c)]{
-
-This parameter handles evaluation of test cases.  The value
-of the parameter is a function that is passed a thunk (a
-function of no arguments). The function, when applied,
-evaluates the expressions within a test case.  The default
-value of the @racket[current-test-case-around] parameters
-evaluates the thunk in a context that catches exceptions and
-prints an appropriate message indicating test case failure.}
-
-@defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{
-
-The @racket[current-test-case-around] parameter is
-parameterized to this value within the scope of a
-@racket[test-suite].  This function creates a test case
-structure instead of immediately evaluating the thunk.}
-
-@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
-
-The @racket[current-check-around] parameter is parameterized
-to this value within the scope of a @racket[test-suite].
-This function creates a test case structure instead of
-immediately evaluating a check.}

collects/rackunit/scribblings/internals.scrbl

@@ -0,0 +1,271 @@
+#lang scribble/doc
+@(require "base.rkt")
+
+@declare-exporting[rackunit #:use-sources (rackunit)]
+
+@title[#:tag "internals"]{RackUnit Internals and Extension API}
+
+This section describes RackUnit's facilities for customizing the
+behavior of checks and tests and for creating new kinds of test
+runners.
+
+@section{Customizing Check Evaluation}
+
+The semantics of checks are determined by the parameters
+@racket[current-check-around] and
+@racket[current-check-handler].  Other testing form such as
+@racket[test-begin] and @racket[test-suite] change the value
+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].
+}
+
+@defparam[current-check-around check (-> (-> any) any)]{
+
+Parameter containing the function that handles the execution
+of checks.  The default value wraps the evaluation of
+@racket[thunk] in a @racket[with-handlers] call that calls
+@racket[current-check-handler] if an exception is raised and then
+(when an exception is not raised) discards the result, returning
+@racket[(void)]. 
+}
+
+@section{Customizing Test Evaluation}
+
+Just like with checks, there are several parameters that
+control the semantics of compound testing forms.
+
+@defparam[current-test-name name (or/c string? false/c)]{
+
+This parameter stores the name of the current test case.  A
+value of @racket[#f] indicates a test case with no name,
+such as one constructed by @racket[test-begin].
+}
+
+@defparam[current-test-case-around handler (-> (-> any) any)]{
+
+This parameter handles evaluation of test cases.  The value
+of the parameter is a function that is passed a thunk (a
+function of no arguments). The function, when applied,
+evaluates the expressions within a test case.  The default
+value of the @racket[current-test-case-around] parameters
+evaluates the thunk in a context that catches exceptions and
+prints an appropriate message indicating test case failure.
+}
+
+@defproc[(test-suite-test-case-around [thunk (-> any)]) any]{
+
+The @racket[current-test-case-around] parameter is
+parameterized to this value within the scope of a
+@racket[test-suite].  This function creates a test case
+structure instead of immediately evaluating the thunk.
+}
+
+@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
+
+The @racket[current-check-around] parameter is parameterized
+to this value within the scope of a @racket[test-suite].
+This function creates a test case structure instead of
+immediately evaluating a check.
+}
+
+@;{--------}
+
+@section[#:tag "running"]{Programmatically Running Tests and Inspecting Results}
+
+RackUnit provides an API for running tests, from which
+custom UIs can be created.
+
+@subsection{Result Types}
+
+@defstruct[(exn:test exn) ()]{
+
+The base structure for RackUnit exceptions.  You should
+never catch instances of this type, only the subtypes
+documented below.}
+
+@defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{
+
+A @racket[exn:test:check] is raised when an check fails, and
+contains the contents of the check-info stack at the
+time of failure.}
+
+@defstruct[test-result ([test-case-name (or/c string #f)])]{
+
+A test-result is the result of running the test with
+the given name (with @racket[#f] indicating no name is available).}
+
+@defstruct[(test-failure test-result) ([result any])]{
+
+Subtype of test-result representing a test failure.}
+
+@defstruct[(test-error test-result) ([result exn])]{
+
+Subtype of test-result representing a test error.}
+
+@defstruct[(test-success test-result) ([result any])]{
+
+Subtype of test-result representing a test success.}
+
+
+@subsection{Functions to Run Tests}
+
+@defproc[(run-test-case (name (or/c string #f)) (action (-> any)))
+         test-result]{
+
+Runs the given test case, returning a result representing success,
+failure, or error.
+}
+
+
+@defproc[(run-test (test (or/c test-case? test-suite?)))
+         (flat-murec-contract ([R (listof (or/c test-result? R))]) R)]{
+
+Runs the given test (test case or test suite) returning a
+tree (list of lists) of results}
+
+Example:
+
+@racketblock[
+  (run-test
+     (test-suite
+      "Dummy"
+      (test-case "Dummy" (check-equal? 1 2))))
+]
+
+@defproc[(fold-test-results [result-fn ('b 'c ... 'a . -> . 'a)]
+                            [seed 'a]
+			    [test (or/c test-case? test-suite?)]
+			    [#:run run (string (() -> any) . -> . 'b 'c ...)]
+ 			    [#:fdown fdown (string 'a . -> . 'a)] 
+			    [#:fup fup (string 'a . -> . 'a)])
+          'a]{
+
+Fold @racket[result-fn] pre-order left-to-right depth-first
+over the results of @racket[run].  By default @racket[run]
+is @racket[run-test-case] and @racket[fdown] and
+@racket[fup] just return the seed, so @racket[result-fn] is
+folded over the test results.
+
+This function is useful for writing custom folds (and hence UIs) over
+test results without you having to take care of all the expected setup
+and teardown.  For example, @racket[fold-test-results] will run test
+suite before and after actions for you.  However it is still flexible
+enough, via its keyword arguments, to do almost anything that
+@racket[foldts] can.  Hence it should be used in preference to @racket[foldts].
+
+The @racket[result-fn] argument is a function from the results of
+@racket[run] (defaults to a @racket[test-result]) and the seed to a
+new seed.
+
+The @racket[seed] argument is any value.
+
+The @racket[test] argument is a test case or test suite.
+
+The @racket[run] argument is a function from a test case name (string)
+and action (thunk) to any values. The values produced by @racket[run]
+are fed into the @scheme[result-fn].
+
+The @racket[fdown] argument is a function from a test suite name
+(string) and the seed, to a new seed.
+
+The @racket[fup] argument is a function from a test suite name
+(string) and the seed, to a new seed.
+}
+
+Examples:
+
+The following code counts the number of successes:
+
+@racketblock[
+(define (count-successes test)
+  (fold-test-results
+   (lambda (result seed)
+     (if (test-success? result)
+         (add1 seed)
+         seed))
+   0
+   test))]
+
+The following code returns the symbol @racket['burp] instead
+of running test cases.  Note how the @racket[result-fn] receives the
+value of @racket[run].
+
+@racketblock[
+(define (burp test)
+  (fold-test-results
+   (lambda (result seed) (cons result seed))
+   null
+   test
+   #:run (lambda (name action) 'burp)))]
+
+
+@defproc[(foldts [fdown (test-suite string thunk thunk 'a -> 'a)]
+		 [fup (test-suite string thunk thunk 'a 'a -> 'a)]
+		 [fhere(test-case string thunk 'a -> 'a)]
+		 [seed 'a]
+		 [test (or/c test-case? test-suite?)])
+    		 'a]{
+
+The @racket[foldts] function is a nifty tree fold (created by Oleg
+Kiselyov) that folds over a test in a useful way
+(@racket[fold-test-results] isn't that useful as you can't specify
+actions around test cases).
+
+The @racket[fdown] argument is a function of test suite, test suite
+name, before action, after action, and the seed.  It is run when a
+test suite is encountered on the way down the tree (pre-order).
+
+The @racket[fup] argument is a function of test suite, test suite
+name, before action, after action, the seed at the current level, and
+the seed returned by the children.  It is run on the way up the tree
+(post-order).
+
+The @racket[fhere] argument is a function of the test case, test case
+name, the test case action, and the seed. (Note that this might change
+in the near future to just the test case.  This change would be to
+allow @racket[fhere] to discriminate subtypes of test-case, which in
+turn would allow test cases that are, for example, ignored).
+}
+
+Example:
+
+Here's the implementation of @racket[fold-test-results] in terms of
+@racket[foldts]:
+
+@racketblock[
+(define (fold-test-results suite-fn case-fn seed test)
+  (foldts
+   (lambda (suite name before after seed)
+     (before)
+     (suite-fn name seed))
+   (lambda (suite name before after seed kid-seed)
+     (after)
+     kid-seed)
+   (lambda (case name action seed)
+     (case-fn
+      (run-test-case name action)
+      seed))
+   seed
+   test))
+]
+
+If you're used to folds you'll probably be a bit surprised that the
+functions you pass to @racket[foldts] receive both the structure they
+operate on, and the contents of that structure.  This is indeed
+unusual.  It is done to allow subtypes of test-case and test-suite to
+be run in customised ways.  For example, you might define subtypes of
+test case that are ignored (not run), or have their execution time
+recorded, and so on.  To do so the functions that run the test cases
+need to know what type the test case has, and hence is is necessary to
+provide this information.
+
+If you've made it this far you truly are a master RackUnit hacker.  As
+a bonus prize we'll just mention that the code in
+@racketfont{hash-monad.rkt} and @racketfont{monad.rkt} might be of
+interest for constructing user interfaces.  The API is still in flux,
+so isn't documented here.  However, do look at the implementation of
+@racket[run-tests] for examples of use.

collects/rackunit/scribblings/misc.scrbl

@@ -8,7 +8,10 @@ bindings that a module does not provide.  It is useful for
 testing the private functions of modules.
 
 @defform[(require/expose module (id ...))]{
-Requires @racket[id] from @racket[module] into the current module.  It doesn't matter if the source module provides the bindings or not; @racket[require/expose] can still get at them.
+
+Requires @racket[id] from @racket[module] into the current module.  It
+doesn't matter if the source module provides the bindings or not;
+@racket[require/expose] can still get at them.
 
 Note that @racket[require/expose] can be a bit fragile,
 especially when mixed with compiled code.  Use at your own risk!

collects/rackunit/scribblings/overview.scrbl

@@ -3,13 +3,17 @@
 
 @title{Overview of RackUnit}
 
-There are three basic data types in RackUnit:
+There are three basic concepts in RackUnit:
 
 @itemize[
 
-@item{A @italic{check} is the basic unit of a test.  As the name suggests, it checks some condition is true.}
+@item{A @italic{check} is the basic unit of a test.  As the name
+suggests, it checks some condition is true.}
 
-@item{A @italic{test case} is a group of checks that form one conceptual unit.  If any check within the case fails, the entire case fails.}
+@item{A @italic{test case} is a group of checks that form one
+conceptual unit.  If any check within the case fails, the entire case
+fails.}
 
-@item{A @italic{test suite} is a group of test cases and test suites that has a name.}
+@item{A @italic{test suite} is a group of test cases and test suites
+that has a name.}
 ]

collects/rackunit/scribblings/philosophy.scrbl

@@ -5,7 +5,7 @@
 
 RackUnit is designed to allow tests to evolve in step with
 the evolution of the program under testing.  RackUnit
-scales from the unstructed checks suitable for simple
+scales from the unstructured checks suitable for simple
 programs to the complex structure necessary for large
 projects.
 
@@ -83,7 +83,7 @@ RackUnit manner (for example, test results may be logged
 for the purpose of improving software quality, or they may
 be displayed on a website to indicate service quality). For
 these programmers it is necessary to delay the execution of
-tests so they can processed in the programmer's chosen
+tests so they can be processed in the programmer's chosen
 manner. To do this, the programmer simply wraps a test-suite
 around their tests:
 

collects/rackunit/scribblings/quick-start.scrbl

@@ -48,19 +48,19 @@ evaluate this file and see if the library is correct.
 Here's the result I get:
 
 @verbatim{
-#t
 --------------------
 FAILURE
 name:       check-equal?
 location:   (file-test.rkt 7 0 117 27)
 expression: (check-equal? (my-* 1 2) 2)
 params:     (4 2)
+message:    "Simple multiplication"
 actual:     4
 expected:   2
 
 --------------------}
 
-The first @racket[#t] indicates the first test passed.  The
+The first test passed and so prints nothing.  The
 second test failed, as shown by the message.
 
 Requiring RackUnit and writing checks is all you need to
@@ -119,7 +119,7 @@ we're testing.  We can give a test case a name with the
     lst)))
 ]
 
-Now if we want to structure our tests are bit more we can
+Now if we want to structure our tests a bit more we can
 group them into a test suite:
 
 @racketblock[

collects/rackunit/scribblings/rackunit.scrbl

@@ -4,7 +4,7 @@
 @title{@bold{RackUnit}: Unit Testing for Racket}
 
 @author[(author+email "Noel Welsh" "noelwelsh@gmail.com")
-        (author+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
+        (author+email "Ryan Culpepper" "ryanc@racket-lang.org")]
 
 RackUnit is a unit-testing framework for Racket.  It
 is designed to handle the needs of all Racket programmers,
@@ -15,6 +15,7 @@ from novices to experts.
 @include-section["quick-start.scrbl"]
 @include-section["philosophy.scrbl"]
 @include-section["api.scrbl"]
+@include-section["internals.scrbl"]
 @include-section["release-notes.scrbl"]
 @include-section["acknowledgements.scrbl"]
 

collects/rackunit/tool.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/class
-         racket/gui
+         racket/gui/base
          framework
          drscheme/tool
          racket/unit

collects/tests/rackunit/pr10950.rkt

@@ -4,13 +4,19 @@
          racket/port
          tests/eli-tester)
 
-(test
+(define output
   (with-output-to-string
      (lambda ()
        (parameterize ([current-error-port (current-output-port)])
          (define-check (check3)
            (fail-check))
          
-         (run-tests (test-suite "tests" (let ((foo check3)) (foo)))))))
+         (run-tests (test-suite "tests" (let ((foo check3)) (foo))))))))
- =>
+
- "--------------------\ntests > #f\nUnnamed test \nFAILURE\nname:       check3\nlocation:   unknown:?:?\nparams:     \n--------------------\n0 success(es) 1 failure(s) 0 error(s) 1 test(s) run\n")
+(test
+ (regexp-match
+  (regexp (format "~a.*~a"
+                 (regexp-quote "--------------------\ntests > #f\nUnnamed test \nFAILURE\nname:       check3\nlocation:   ")
+                 
+                 (regexp-quote "/collects/tests/rackunit/pr10950.rkt:14:51\nparams:     \n--------------------\n0 success(es) 1 failure(s) 0 error(s) 1 test(s) run\n")))
+  output))

collects/tests/rackunit/standalone-test-case-test.rkt

@@ -12,8 +12,8 @@
 (test-case "succeed" (check-eq? 1 1))
 
 ;; These should raise errors
-(test-begin (error "Outta here!"))
+(test-begin (error "First Outta here!"))
-(test-case "error" (error "Outta here!"))
+(test-case "error" (error "Second Outta here!"))
 
 ;; Thesse should raise failures
 (test-begin (check-eq? 1 2))

collects/tests/rackunit/standalone.rkt

@@ -0,0 +1,37 @@
+#lang racket/base
+(require racket/runtime-path
+         rackunit
+         racket/path)
+
+(define-runtime-path here ".")
+(define collects 
+  (normalize-path (build-path here ".." "..")))
+(define (collect-trim bs)
+  (regexp-replace* (regexp-quote (path->bytes collects)) bs #"PLTHOME/collects"))
+  
+(define (require&catch path)
+  (define out-bs (open-output-bytes))
+  (define err-bs (open-output-bytes))
+  (parameterize ([current-output-port out-bs]
+                 [current-error-port err-bs])
+    (dynamic-require path #f))
+  (close-output-port out-bs)
+  (close-output-port err-bs)
+  (values (collect-trim (get-output-bytes out-bs))
+          (collect-trim (get-output-bytes err-bs))))
+
+(define-syntax-rule (test-file pth out err)
+  (begin
+    (define-runtime-module-path mod (file pth))
+    (define-values (cout cerr) (require&catch mod))
+    (check-equal? cout out)
+    (check-equal? cerr err)))
+
+(test-file "standalone-check-test.rkt"
+           #"Oh HAI!\nI didn't run\n"
+           #"--------------------\nERROR\nOutta here!\n\n === context ===\nPLTHOME/collects/tests/rackunit/standalone-check-test.rkt:40:12: temp7\nPLTHOME/collects/rackunit/private/check.rkt:144:29\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\nPLTHOME/collects/rackunit/private/check.rkt:77:0: top-level-check-around\n\n\n--------------------\n--------------------\nFAILURE\nname:       check\nlocation:   (#<path:PLTHOME/collects/tests/rackunit/standalone-check-test.rkt> 44 0 1344 17)\nexpression: (check = 1 2)\nparams:     (#<procedure:=> 1 2)\nmessage:    0.0\n\n--------------------\n")
+
+(test-file "standalone-test-case-test.rkt"
+           #"#t\n#t\n"
+           #"--------------------\nUnnamed test \nERROR\nFirst Outta here!\n\n === context ===\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\n\n\n--------------------\n--------------------\nerror\nERROR\nSecond Outta here!\n\n === context ===\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\n\n\n--------------------\n--------------------\nUnnamed test \nFAILURE\nname:       check-eq?\nlocation:   (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 19 12 520 15)\nexpression: (check-eq? 1 2)\nparams:     (1 2)\nactual:     1\nexpected:   2\n\n--------------------\n--------------------\nfailure\nFAILURE\nname:       check-eq?\nlocation:   (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 20 21 558 15)\nexpression: (check-eq? 1 2)\nparams:     (1 2)\nactual:     1\nexpected:   2\n\n--------------------\n")
+

collects/tests/rackunit/tl.rkt

@@ -0,0 +1,28 @@
+#lang racket/base
+(require rackunit)
+
+;; test to make sure that the various check functions
+;; return what they are promised to at the top-level
+
+;; make drdr notice when a check prints something.
+(current-output-port (current-error-port))
+
+(check-equal? (check + 1 2) (void))
+
+(check-equal? (check-eq? 1 1) (void))
+(check-equal? (check-not-eq? #f #t) (void))
+(check-equal? (check-eqv? (expt 2 100) (expt 2 100)) (void))
+(check-equal? (check-not-eqv? (expt 2 100) 1) (void))
+(check-equal? (check-equal? (list 1 2) (list 1 2)) (void))
+(check-equal? (check-not-equal? (list 1 2) (list 2 1)) (void))
+
+(check-equal? (check-pred not #f) (void))
+(check-equal? (check-= 1.1 1.2 0.5) (void))
+(check-equal? (check-true #t) (void))
+(check-equal? (check-false #f) (void))
+(check-equal? (check-not-false 3) (void))
+
+(check-equal? (check-exn #rx"car" (λ () (car 1))) (void))
+(check-equal? (check-not-exn (λ () 1)) (void))
+
+(check-equal? (check-regexp-match #rx"a*b" "aaaaaaab") (void))