rackunit: added #:wait? arg to test/gui

collects/rackunit/gui.rkt

@@ -1,20 +1,29 @@
 #lang racket/base
 (require racket/contract
-         (rename-in "private/base.rkt")
+         racket/gui/base
+         "private/base.rkt"
          "private/gui/gui.rkt")
 
-(define (test/gui . tests)
-  (let ([runner (make-gui-runner)])
-    (sleep 0.1) ;; give the gui a chance to initialize
-    (apply runner tests)))
+(define (test/gui #:wait? [wait? #f]
+                  . tests)
+  (let* ([es (make-eventspace)]
+         [runner
+          (parameterize ((current-eventspace es))
+            (make-gui-runner))])
+    (sleep/yield 0.1) ;; give the gui a chance to initialize
+    (apply runner tests)
+    (when wait? (void (sync es)))))
 
 (define test/c (or/c rackunit-test-case? rackunit-test-suite?))
 
 (provide/contract
  [test/gui
-  (->* () () #:rest (listof test/c)
+  (->* ()
+       (#:wait? any/c)
+       #:rest (listof test/c)
        any)]
  [make-gui-runner
-  (->
-   (->* () () #:rest (listof test/c)
-        any))])
+  (->* ()
+       ()
+       (->* () () #:rest (listof test/c)
+            any))])

collects/rackunit/private/gui/gui.rkt

@@ -14,8 +14,7 @@
   (define controller
     (new controller%))
   (define frame
-    (parameterize ((current-eventspace (make-eventspace)))
-      (make-view-frame controller)))
+    (make-view-frame controller))
   (lambda tests
     (for ([test (in-list tests)])
       (run test controller))))

collects/rackunit/scribblings/ui.scrbl

@@ -38,12 +38,15 @@ information.
 RackUnit also provides a GUI test runner, available from the
 @racketmodname[rackunit/gui] module.
 
-@defproc[(test/gui [test (or/c test-case? test-suite?)] ...)
-         any]{
+@defproc[(test/gui [test (or/c test-case? test-suite?)] ...
+                   [#:wait? wait? boolean? #f])
+         void?]{
 
 Creates a new RackUnit GUI window and runs each @racket[test]. The
 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.
 }
 
 @defproc[(make-gui-runner)

collects/tests/db/all-tests.rkt

@@ -243,10 +243,7 @@ Testing profiles are flattened, not hierarchical.
                [else tests])])
    (cond [gui?
           (let* ([test/gui (dynamic-require 'rackunit/gui 'test/gui)])
-            (apply test/gui (map cdr tests))
-            (eprintf "Press Cntl-C to end.\n") ;; HACK!
-            (with-handlers ([exn:break? (lambda _ (newline) (exit))])
-              (sync never-evt)))]
+            (apply test/gui #:wait? #t (map cdr tests)))]
          [else
           (for ([test tests])
             (printf "Running ~s tests\n" (car test))