diff --git a/collects/rackunit/gui.rkt b/collects/rackunit/gui.rkt index 8baf65ae35..6e7434a6a4 100644 --- a/collects/rackunit/gui.rkt +++ b/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))]) diff --git a/collects/rackunit/private/gui/gui.rkt b/collects/rackunit/private/gui/gui.rkt index 408c896cb5..0df37bb0b4 100644 --- a/collects/rackunit/private/gui/gui.rkt +++ b/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)))) diff --git a/collects/rackunit/scribblings/ui.scrbl b/collects/rackunit/scribblings/ui.scrbl index f77e6ccc94..ececf6f7ef 100644 --- a/collects/rackunit/scribblings/ui.scrbl +++ b/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) diff --git a/collects/tests/db/all-tests.rkt b/collects/tests/db/all-tests.rkt index 99cdd3055a..66b7307206 100644 --- a/collects/tests/db/all-tests.rkt +++ b/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))