diff --git a/collects/rackunit/gui.rkt b/collects/rackunit/gui.rkt index 8baf65a..6e7434a 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 408c896..0df37bb 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 f77e6cc..ececf6f 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/rackunit/tool.rkt b/collects/rackunit/tool.rkt index ba75e1a..230df69 100644 --- a/collects/rackunit/tool.rkt +++ b/collects/rackunit/tool.rkt @@ -3,8 +3,7 @@ racket/gui/base framework drscheme/tool - racket/unit - (prefix-in drlink: "private/gui/drracket-link.rkt")) + racket/unit) (provide tool@) @@ -13,8 +12,6 @@ (define BACKTRACE-NO-MESSAGE "No message.") (define LINK-MODULE-SPEC 'rackunit/private/gui/drracket-link) -(define-namespace-anchor drracket-ns-anchor) - ;; ---- ;; close/eventspace : (a* -> b) -> (a* -> b) @@ -63,25 +60,17 @@ (drscheme:debug:open-and-highlight-in-file (list (make-srcloc src #f #f pos span)))))) - ;; Send them off to the drscheme-ui module. - ;; We'll still have to attach our instantiation of drscheme-link - ;; to the user namespace. - (set-box! drlink:link - (vector get-errortrace-backtrace - show-backtrace - show-source)) - - (define drracket-ns (namespace-anchor->namespace drracket-ns-anchor)) - (define interactions-text-mixin (mixin ((class->interface drscheme:rep:text%)) () (inherit get-user-namespace) (super-new) (define/private (setup-helper-module) - (namespace-attach-module drracket-ns - LINK-MODULE-SPEC - (get-user-namespace))) + (let ([link (parameterize ((current-namespace (get-user-namespace))) + (dynamic-require LINK-MODULE-SPEC 'link))]) + (set-box! link (vector get-errortrace-backtrace + show-backtrace + show-source)))) (define/override (reset-console) (super reset-console)