From cda12b39ed2c98ddfa926bae2fbc26287503b8a0 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 5 Sep 2011 14:12:09 -0500 Subject: [PATCH] more adjustment of the drracket test suites to avoid using os-given focus information also increase the timeout of the io.rkt test --- collects/meta/props | 2 +- collects/tests/drracket/language-test.rkt | 8 ++++---- collects/tests/drracket/module-lang-test-utils.rkt | 4 ++-- collects/tests/drracket/private/randomly-click.rkt | 11 ++++------- collects/tests/drracket/repl-test.rkt | 4 ++-- .../tests/drracket/sample-solutions-one-window.rkt | 2 +- collects/tests/drracket/teachpack.rkt | 6 +++--- collects/tests/drracket/test-engine-test.rkt | 4 ++-- collects/tests/drracket/time-keystrokes.rkt | 2 +- 9 files changed, 20 insertions(+), 23 deletions(-) diff --git a/collects/meta/props b/collects/meta/props index 5a5e0ea0b5..8595c0e60e 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1432,7 +1432,7 @@ path/s is either such a string or a list of them. "collects/tests/drracket/example-tool.rkt" drdr:command-line (gracket "-t" *) "collects/tests/drracket/get-defs-test.rkt" drdr:command-line (gracket *) "collects/tests/drracket/hangman.rkt" responsible (robby matthias) drdr:command-line (gracket *) -"collects/tests/drracket/io.rkt" drdr:command-line (gracket *) +"collects/tests/drracket/io.rkt" drdr:command-line (gracket *) drdr:timeout 500 "collects/tests/drracket/language-test.rkt" responsible (robby matthias) drdr:command-line (gracket *) drdr:timeout 600 "collects/tests/drracket/leaky-frame.rkt" drdr:command-line (gracket *) "collects/tests/drracket/memory-log.rkt" drdr:command-line (gracket *) diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index a2a5b62f28..8bf26b1bf7 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -1107,10 +1107,10 @@ the settings above should match r5rs (define (test-setting set-setting setting-name expression result) (set-language #f) (set-setting) - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (fw:test:button-push "OK") (wait-for-new-frame f)) - (let* ([drs (get-top-level-focus-window)] + (let* ([drs (test:get-active-top-level-window)] [interactions (send drs get-interactions-text)]) (clear-definitions drs) (type-in-definitions drs expression) @@ -1124,7 +1124,7 @@ the settings above should match r5rs (define (test-hash-bang) (let* ([expression "#!/bin/sh\n1"] [result "1"] - [drs (get-top-level-focus-window)] + [drs (test:get-active-top-level-window)] [interactions (queue-callback (λ () (send drs get-interactions-text)))]) (clear-definitions drs) (type-in-definitions drs expression) @@ -1235,7 +1235,7 @@ the settings above should match r5rs (fw:test:set-check-box! "Insert newlines in printed values" pretty?) - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (fw:test:button-push "OK") (wait-for-new-frame f)))] [shorten diff --git a/collects/tests/drracket/module-lang-test-utils.rkt b/collects/tests/drracket/module-lang-test-utils.rkt index 6782c02d92..284899f0d9 100644 --- a/collects/tests/drracket/module-lang-test-utils.rkt +++ b/collects/tests/drracket/module-lang-test-utils.rkt @@ -147,7 +147,7 @@ (set-module-language! #f) (test:set-radio-box-item! "Debugging") - (let ([f (queue-callback/res (λ () (get-top-level-focus-window)))]) + (let ([f (queue-callback/res (λ () (test:get-active-top-level-window)))]) (test:button-push "OK") (wait-for-new-frame f)) @@ -163,7 +163,7 @@ (define (setup-dialog/run proc) (set-module-language! #f) (proc) - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (test:button-push "OK") (wait-for-new-frame f)) (do-execute drs) diff --git a/collects/tests/drracket/private/randomly-click.rkt b/collects/tests/drracket/private/randomly-click.rkt index a9ebd6e917..0e975eaf0e 100644 --- a/collects/tests/drracket/private/randomly-click.rkt +++ b/collects/tests/drracket/private/randomly-click.rkt @@ -69,7 +69,7 @@ (send area get-label)])) (define (g open-dialog) - (let ((base-window (get-top-level-focus-window))) + (let ((base-window (test:get-active-top-level-window))) (open-dialog) (wait-for-different-frame base-window) (let loop ([n numButtonsToPush] @@ -84,7 +84,7 @@ (when (= 1 (modulo n 10)) (printf "\n")) (flush-output) - (let ((window (get-top-level-focus-window))) + (let ((window (test:get-active-top-level-window))) (cond ;; Back to base-window is not interesting, Reopen [(eq? base-window window) @@ -92,9 +92,6 @@ (wait-for-different-frame base-window) (loop (- n 1) actions)] - ;; get-top-level-focus-window returns #f may imply window not in current eventspace - ;; but it also might just mean we didn't look into subeventspaces(?) - ;; or that we need to wait for something to happen in the GUI(?) [(eq? window #f) (sleep .1) (loop (- n 1) actions)] @@ -137,7 +134,7 @@ ;; the splash screen is in a separate eventspace so wont' show up. (define (wait-for-first-frame) (let loop () - (let ([tlw (get-top-level-focus-window)]) + (let ([tlw (test:get-active-top-level-window)]) (cond [(not tlw) (sleep 1/20) @@ -151,7 +148,7 @@ [(zero? n) (error 'wait-for-different-frame "never got that new window, only this one: ~s" win)] [else - (let ([tlw (get-top-level-focus-window)]) + (let ([tlw (test:get-active-top-level-window)]) (when (eq? win tlw) (sleep 1/10) (loop (- n 1))))]))) diff --git a/collects/tests/drracket/repl-test.rkt b/collects/tests/drracket/repl-test.rkt index 7d2ff09807..d32d03a809 100644 --- a/collects/tests/drracket/repl-test.rkt +++ b/collects/tests/drracket/repl-test.rkt @@ -1336,7 +1336,7 @@ This produces an ACK message (begin (set-language-level! level #f) (test:set-radio-box-item! "No debugging or profiling") - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (test:button-push "OK") (wait-for-new-frame f)))] [(debug) @@ -1345,7 +1345,7 @@ This produces an ACK message (begin (set-language-level! level #f) (test:set-radio-box-item! "Debugging and profiling") - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (test:button-push "OK") (wait-for-new-frame f)))]) diff --git a/collects/tests/drracket/sample-solutions-one-window.rkt b/collects/tests/drracket/sample-solutions-one-window.rkt index f0e2a88e7e..9ee0c97a64 100644 --- a/collects/tests/drracket/sample-solutions-one-window.rkt +++ b/collects/tests/drracket/sample-solutions-one-window.rkt @@ -110,7 +110,7 @@ (custodian-shutdown-all cust)))) (let ([wait-for-kill-window (lambda () - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (and f (equal? (send f get-label) "Evaluation Terminated"))))]) (poll-until wait-for-kill-window) diff --git a/collects/tests/drracket/teachpack.rkt b/collects/tests/drracket/teachpack.rkt index 2aabd7fd88..d7582899b3 100644 --- a/collects/tests/drracket/teachpack.rkt +++ b/collects/tests/drracket/teachpack.rkt @@ -109,11 +109,11 @@ (lambda () (let ([active (or - (get-top-level-focus-window) + (test:get-active-top-level-window) (and (send interactions-text get-user-eventspace) (parameterize ([current-eventspace (send interactions-text get-user-eventspace)]) - (get-top-level-focus-window))))]) + (test:get-active-top-level-window))))]) (if (and active (not (eq? active drs-frame))) active #f)))]) @@ -198,7 +198,7 @@ (fw:test:menu-select "Language" "Clear All Teachpacks") (fw:test:menu-select "Language" "Add Teachpack...") (wait-for-new-frame drs-frame) - (let* ([tp-dialog (get-top-level-focus-window)] + (let* ([tp-dialog (test:get-active-top-level-window)] [choice (find/select-relevant-choice tp-dialog (path->string teachpack))]) (fw:test:button-push "OK") (wait-for-new-frame tp-dialog)) diff --git a/collects/tests/drracket/test-engine-test.rkt b/collects/tests/drracket/test-engine-test.rkt index ad421d727b..e78232459b 100644 --- a/collects/tests/drracket/test-engine-test.rkt +++ b/collects/tests/drracket/test-engine-test.rkt @@ -201,10 +201,10 @@ (define (test-setting set-setting setting-name expression result) (set-language #f) (set-setting) - (let ([f (get-top-level-focus-window)]) + (let ([f (test:get-active-top-level-window)]) (fw:test:button-push "OK") (wait-for-new-frame f)) - (let* ([drs (get-top-level-focus-window)] + (let* ([drs (test:get-active-top-level-window)] [interactions (send drs get-interactions-text)]) (clear-definitions drs) (type-in-definitions drs expression) diff --git a/collects/tests/drracket/time-keystrokes.rkt b/collects/tests/drracket/time-keystrokes.rkt index c1e57b1017..6980a475fd 100644 --- a/collects/tests/drracket/time-keystrokes.rkt +++ b/collects/tests/drracket/time-keystrokes.rkt @@ -41,7 +41,7 @@ (let loop ([n 10]) (when (zero? n) (error 'time-keystrokes "could not find drscheme frame")) - (let ([front-frame (get-top-level-focus-window)]) + (let ([front-frame (test:get-active-top-level-window)]) (unless (eq? front-frame frame) (sleep 1/10) (loop (- n 1)))))