From fb25dc9a4215da32c486bf0bf45cb9e73f7df384 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 29 Dec 2010 20:31:40 -0600 Subject: [PATCH] adjusted drracket test suites so that it is (more) careful to keep all manipulation of GUI objects (text% objects seem to have been the important one) on the drracket eventspace main thread in an effort to make the test suites more stable. --- collects/drracket/private/rep.rkt | 11 +-- .../tests/drracket/drracket-test-util.rkt | 84 ++++++++++++++---- collects/tests/drracket/io.rkt | 12 ++- collects/tests/drracket/language-test.rkt | 56 ++++++------ .../tests/drracket/module-lang-test-utils.rkt | 50 ++++++----- collects/tests/drracket/repl-test.rkt | 86 +++++++++---------- .../tests/drracket/teaching-lang-coverage.rkt | 2 +- 7 files changed, 181 insertions(+), 120 deletions(-) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index ed829b91b0..c608fe814f 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -235,11 +235,12 @@ TODO ;; for use in debugging the stack trace stuff #; (when (exn? exn) - (print-struct #t) - (for-each - (λ (frame) (printf " ~s\n" frame)) - (continuation-mark-set->context (exn-continuation-marks exn))) - (printf "\n")) + (parameterize ([print-struct #t]) + (for-each + (λ (frame) (printf " ~s\n" frame)) + (continuation-mark-set->context (exn-continuation-marks exn))) + (printf "\n"))) + (drracket:debug:error-display-handler/stacktrace msg exn stack))) (define (main-user-eventspace-thread?) diff --git a/collects/tests/drracket/drracket-test-util.rkt b/collects/tests/drracket/drracket-test-util.rkt index d64427d7c9..7c343930c0 100644 --- a/collects/tests/drracket/drracket-test-util.rkt +++ b/collects/tests/drracket/drracket-test-util.rkt @@ -11,7 +11,8 @@ [use-get/put-dialog (-> (-> any) path? void?)] [set-module-language! (->* () (boolean?) void?)]) - (provide fire-up-drscheme-and-run-tests + (provide queue-callback/res + fire-up-drscheme-and-run-tests save-drscheme-window-as do-execute test-util-error @@ -42,6 +43,7 @@ ;; use the "save as" dialog in drscheme to save the definitions ;; window to a file. (define (save-drscheme-window-as filename) + (not-on-eventspace-handler-thread 'save-drscheme-window-as) (use-get/put-dialog (lambda () (fw:test:menu-select "File" "Save Definitions As...")) @@ -50,6 +52,7 @@ ;; open-dialog is a thunk that should open the dialog ;; filename is a string naming a file that should be typed into the dialog (define (use-get/put-dialog open-dialog filename) + (not-on-eventspace-handler-thread 'use-get/put-dialog) (let ([drs (wait-for-drscheme-frame)]) (with-handlers ([(lambda (x) #t) (lambda (x) @@ -141,7 +144,8 @@ ;; waits for it to be re-enabled, indicating that the computation ;; is complete. (define (wait-for-computation frame) - (verify-drscheme-frame-frontmost 'wait-for-computation frame) + (not-on-eventspace-handler-thread 'wait-for-computation) + (queue-callback/res (λ () (verify-drscheme-frame-frontmost 'wait-for-computation frame))) (let* ([wait-for-computation-to-start (lambda () (fw:test:reraise-error) @@ -159,24 +163,26 @@ [(frame) (do-execute frame #t)] [(frame wait-for-finish?) - (verify-drscheme-frame-frontmost 'do-execute frame) - (let ([button (send frame get-execute-button)]) + (not-on-eventspace-handler-thread 'do-execute) + (queue-callback/res (λ () (verify-drscheme-frame-frontmost 'do-execute frame))) + (let ([button (queue-callback/res (λ () (send frame get-execute-button)))]) (fw:test:run-one (lambda () (send button command))) (when wait-for-finish? (wait-for-computation frame)))])) (define (verify-drscheme-frame-frontmost function-name frame) + (on-eventspace-handler-thread 'verify-drscheme-frame-frontmost) (let ([tl (get-top-level-focus-window)]) (unless (and (eq? frame tl) (drscheme-frame? tl)) (error function-name "drscheme frame not frontmost: ~e (found ~e)" frame tl)))) (define (clear-definitions frame) - (verify-drscheme-frame-frontmost 'clear-definitions frame) - (fw:test:new-window (send frame get-definitions-canvas)) - (let ([window (send frame get-focus-window)]) - (let-values ([(cw ch) (send window get-client-size)] - [(w h) (send window get-size)]) + (queue-callback/res (λ () (verify-drscheme-frame-frontmost 'clear-definitions frame))) + (fw:test:new-window (queue-callback/res (λ () (send frame get-definitions-canvas)))) + (let ([window (queue-callback/res (λ () (send frame get-focus-window)))]) + (let-values ([(cw ch) (queue-callback/res (λ () (send window get-client-size)))] + [(w h) (queue-callback/res (λ () (send window get-size)))]) (fw:test:mouse-click 'left (inexact->exact (floor (+ cw (/ (- w cw) 2)))) (inexact->exact (floor (+ ch (/ (- h ch) 2))))))) @@ -186,15 +192,20 @@ "Delete"))) (define (type-in-definitions frame str) + (not-on-eventspace-handler-thread 'type-in-definitions) (put-in-frame (lambda (x) (send x get-definitions-canvas)) frame str #f 'type-in-definitions)) (define (type-in-interactions frame str) + (not-on-eventspace-handler-thread 'type-in-interactions) (put-in-frame (lambda (x) (send x get-interactions-canvas)) frame str #f 'type-in-interactions)) (define (insert-in-definitions frame str) + (not-on-eventspace-handler-thread 'insert-in-definitions) (put-in-frame (lambda (x) (send x get-definitions-canvas)) frame str #t 'insert-in-definitions)) (define (insert-in-interactions frame str) + (not-on-eventspace-handler-thread 'insert-in-interactions) (put-in-frame (lambda (x) (send x get-interactions-canvas)) frame str #t 'insert-in-interactions)) (define (put-in-frame get-canvas frame str/sexp just-insert? who) + (not-on-eventspace-handler-thread 'put-in-frame) (unless (and (object? frame) (is-a? frame top-level-window<%>)) (error who "expected a frame or a dialog as the first argument, got ~e" frame)) (let ([str (if (string? str/sexp) @@ -203,10 +214,10 @@ (parameterize ([current-output-port port]) (write str/sexp port)) (get-output-string port)))]) - (verify-drscheme-frame-frontmost who frame) - (let ([canvas (get-canvas frame)]) + (queue-callback/res (λ () (verify-drscheme-frame-frontmost who frame))) + (let ([canvas (queue-callback/res (λ () (get-canvas frame)))]) (fw:test:new-window canvas) - (let ([editor (send canvas get-editor)]) + (let ([editor (queue-callback/res (λ () (send canvas get-editor)))]) (cond [just-insert? (let ([s (make-semaphore 0)]) @@ -218,11 +229,20 @@ (unless (sync/timeout 3 s) (error who "callback didn't run for 3 seconds; trying to insert ~s" str/sexp)))] [else - (send editor set-caret-owner #f) + (queue-callback/res (λ () (send editor set-caret-owner #f))) (type-string str)]))))) + (define (queue-callback/res thunk) + (not-on-eventspace-handler-thread 'queue-callback/res) + (let ([c (make-channel)]) + (queue-callback (λ () (channel-put c (with-handlers ((exn:fail? values)) (call-with-values thunk list))))) + (define res (channel-get c)) + (when (exn? res) (raise res)) + (apply values res))) + (define (alt-return-in-interactions frame) - (verify-drscheme-frame-frontmost 'alt-return-in-interactions frame) + (not-on-eventspace-handler-thread 'alt-return-in-interactions) + (queue-callback/res (λ () (verify-drscheme-frame-frontmost 'alt-return-in-interactions frame))) (let ([canvas (send frame get-interactions-canvas)]) (fw:test:new-window canvas) (let ([editor (send canvas get-editor)]) @@ -232,6 +252,7 @@ ;; type-string : string -> void ;; to call test:keystroke repeatedly with the characters (define (type-string str) + (not-on-eventspace-handler-thread 'type-string) (let ([len (string-length str)]) (let loop ([i 0]) (unless (>= i len) @@ -271,6 +292,7 @@ ;;; (get-sub-panel '(2 0) frame) gets the 0th child of the 2nd child of the top-panel (define (get-sub-panel path frame) + (on-eventspace-handler-thread 'get-sub-panel) (letrec ([loop (lambda (path panel) (if (null? path) @@ -286,6 +308,7 @@ ;;; of the last line (define (get-text-pos text) + (on-eventspace-handler-thread 'get-text-pos) (let* ([last-pos (send text last-position)] [last-line (send text position-line last-pos)]) (send text line-start-position last-line))) @@ -293,13 +316,15 @@ ; poll for enabled button (define (wait-for-button button) + (not-on-eventspace-handler-thread 'wait-for-button) (poll-until (let ([wait-for-button-pred (lambda () - (send button is-enabled?))]) + (queue-callback/res (λ () (send button is-enabled?))))]) wait-for-button-pred))) (define (push-button-and-wait button) + (not-on-eventspace-handler-thread 'push-button-and-wait) (fw:test:button-push button) (poll-until (let ([button-push-and-wait-pred @@ -318,6 +343,7 @@ (list? in-language-spec) (andmap (lambda (x) (or string? regexp?)) in-language-spec)) (error 'set-language-level! "expected a non-empty list of regexps and strings for language, got: ~e" in-language-spec)) + (not-on-eventspace-handler-thread 'set-language-level!) (let ([drs-frame (get-top-level-focus-window)]) (fw:test:menu-select "Language" "Choose Language...") (let* ([language-dialog (wait-for-new-frame drs-frame)] @@ -384,6 +410,7 @@ new-frame drs-frame)))))))) (define (set-module-language! [close-dialog? #t]) + (not-on-eventspace-handler-thread 'set-module-language!) (let ([drs-frame (get-top-level-focus-window)]) (fw:test:menu-select "Language" "Choose Language...") (let* ([language-dialog (wait-for-new-frame drs-frame)]) @@ -407,6 +434,7 @@ ;; checks that the language in the drscheme window is set to the given one. ;; clears the definitions, clicks execute and checks the interactions window. (define (check-language-level lang-spec) + (not-on-eventspace-handler-thread 'check-language-level!) (let* ([drs-frame (wait-for-drscheme-frame)] [interactions (send drs-frame get-interactions-text)] [definitions-canvas (send drs-frame get-definitions-canvas)]) @@ -414,21 +442,28 @@ (fw:test:menu-select "Edit" "Select All") (fw:test:menu-select "Edit" "Delete") (do-execute drs-frame) - (let ([lang-line (send interactions get-text - (send interactions line-start-position 1) - (send interactions line-end-position 1))]) + (let ([lang-line (queue-callback/res + (λ () + (send interactions get-text + (send interactions line-start-position 1) + (send interactions line-end-position 1))))]) (unless (regexp-match lang-spec lang-line) (error 'check-language-level "expected ~s to match ~s" lang-line lang-spec))))) (define (repl-in-edit-sequence?) - (send (send (wait-for-drscheme-frame) get-interactions-text) refresh-delayed?)) + (not-on-eventspace-handler-thread 'repl-in-edit-sequence?) + (let ([drr (wait-for-drscheme-frame)]) + (queue-callback/res + (λ () + (send (send drr get-interactions-text) refresh-delayed?))))) ;; has-error? : frame -> (union #f string) ;; returns the error text of an error in the interactions window of the frame or #f if there is none. ;; ensures that frame is front most. (define (has-error? frame) + (not-on-eventspace-handler-thread 'repl-in-edit-sequence?) (run-one/sync (lambda () (verify-drscheme-frame-frontmost 'had-error? frame) @@ -470,6 +505,7 @@ (case-lambda [(frame) (fetch-output frame #f #f)] [(frame _start _end) + (not-on-eventspace-handler-thread 'fetch-output) (run-one/sync (lambda () (verify-drscheme-frame-frontmost 'fetch-output frame) @@ -537,6 +573,7 @@ ;; waits for it to complete. Also propogates ;; exceptions. (define (run-one/sync f) + (not-on-eventspace-handler-thread 'repl-in-edit-sequence?) (let ([s (make-semaphore 0)] [raised-exn? #f] [exn #f] @@ -558,6 +595,7 @@ (define orig-display-handler (error-display-handler)) (define (fire-up-drscheme-and-run-tests run-test) + (on-eventspace-handler-thread 'fire-up-drscheme-and-run-tests) (let () ;; change the preferences system so that it doesn't write to ;; a file; partly to avoid problems of concurrency in drdr @@ -590,3 +628,11 @@ (run-test) (exit))) (yield (make-semaphore 0)))) + +(define (not-on-eventspace-handler-thread fn) + (when (eq? (current-thread) (eventspace-handler-thread (current-eventspace))) + (error fn "expected to be run on some thread other than the eventspace handler thread"))) + +(define (on-eventspace-handler-thread fn) + (unless (eq? (current-thread) (eventspace-handler-thread (current-eventspace))) + (error fn "expected to be run on the eventspace handler thread"))) \ No newline at end of file diff --git a/collects/tests/drracket/io.rkt b/collects/tests/drracket/io.rkt index 6a2ef6a7fa..5d2050b7cf 100644 --- a/collects/tests/drracket/io.rkt +++ b/collects/tests/drracket/io.rkt @@ -123,7 +123,7 @@ add this test: (do-execute drs-frame) (type-in-interactions drs-frame program) (let ([before-newline-pos (send interactions-text last-position)]) - (type-in-interactions drs-frame (string #\newline)) + (type-in-interactions drs-frame "\n") (wait (λ () ;; the focus moves to the input box, so wait for that. (send interactions-text get-focus-snip)) @@ -133,9 +133,13 @@ add this test: (wait-for-computation drs-frame) (let ([got-value (fetch-output drs-frame - (send interactions-text paragraph-start-position 3) ;; start after test expression - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))]) + (queue-callback/res + (λ () + (send interactions-text paragraph-start-position 3))) ;; start after test expression + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) (unless (equal? got-value expected-transcript) (fprintf (current-error-port) "FAILED: expected: ~s\n got: ~s\n program: ~s\n input: ~s\n" diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index a81307c2e2..5b548a5ffb 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -1189,7 +1189,7 @@ the settings above should match r5rs (let* ([expression "#!/bin/sh\n1"] [result "1"] [drs (get-top-level-focus-window)] - [interactions (send drs get-interactions-text)]) + [interactions (queue-callback (λ () (send drs get-interactions-text)))]) (clear-definitions drs) (type-in-definitions drs expression) (do-execute drs) @@ -1215,9 +1215,12 @@ the settings above should match r5rs (do-execute drs) (let* ([interactions (send drs get-interactions-text)] [short-lang (last (language))] - [get-line (lambda (n) (send interactions get-text - (send interactions paragraph-start-position n) - (send interactions paragraph-end-position n)))] + [get-line (lambda (n) + (queue-callback/res + (λ () + (send interactions get-text + (send interactions paragraph-start-position n) + (send interactions paragraph-end-position n)))))] [line0-expect (format "Welcome to DrRacket, version ~a [~a]." (version:version) (system-type 'gc))] @@ -1372,19 +1375,21 @@ the settings above should match r5rs (define (test-error-after-definition) (let* ([drs (wait-for-drscheme-frame)] - [interactions-text (send drs get-interactions-text)]) + [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))]) (clear-definitions drs) (type-in-definitions drs "(define y 0) (define (f x) (/ x y)) (f 2)") (do-execute drs) - (let ([last-para (send interactions-text last-paragraph)]) + (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) (type-in-interactions drs "y\n") (wait-for-computation drs) (let ([got (fetch-output/should-be-tested drs - (send interactions-text paragraph-start-position (+ last-para 1)) - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))]) + (queue-callback/res (λ () (send interactions-text paragraph-start-position (+ last-para 1)))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) (unless (equal? got "0") (fprintf (current-error-port) "FAILED: test-error-after-definition failed, expected 0, got ~s\n" got)))))) @@ -1397,8 +1402,8 @@ the settings above should match r5rs ;; types an expression in the REPL and tests the output from the REPL. (define (test-expression expression defs-expected [repl-expected defs-expected]) (let* ([drs (wait-for-drscheme-frame)] - [interactions-text (send drs get-interactions-text)] - [definitions-text (send drs get-definitions-text)] + [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))] + [definitions-text (queue-callback/res (λ () (send drs get-definitions-text)))] [handle-insertion (lambda (item) (cond @@ -1440,9 +1445,11 @@ the settings above should match r5rs (let ([got (fetch-output drs - (send interactions-text paragraph-start-position 2) - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))]) + (queue-callback/res (λ () (send interactions-text paragraph-start-position 2))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) (when (regexp-match re:out-of-sync got) (error 'text-expression "got out of sync message")) (unless (check-expectation defs-expected got) @@ -1450,9 +1457,8 @@ the settings above should match r5rs (make-err-msg defs-expected) 'definitions (language) expression defs-expected got))) - (let ([s (make-semaphore 0)] - [dp (defs-prefix)]) - (queue-callback + (let ([dp (defs-prefix)]) + (queue-callback/res (λ () ;; select all except the defs-prefix (send definitions-text set-position @@ -1463,19 +1469,21 @@ the settings above should match r5rs (send interactions-text set-position (send interactions-text last-position) (send interactions-text last-position)) - (send interactions-text paste) - (semaphore-post s))) - (semaphore-wait s)) + (send interactions-text paste)))) - (let ([last-para (send interactions-text last-paragraph)]) + (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) (alt-return-in-interactions drs) (wait-for-computation drs) (let ([got (fetch-output drs - (send interactions-text paragraph-start-position (+ last-para 1)) - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))]) + (queue-callback/res + (λ () + (send interactions-text paragraph-start-position (+ last-para 1)))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) (when (regexp-match re:out-of-sync got) (error 'text-expression "got out of sync message")) (unless (check-expectation repl-expected got) diff --git a/collects/tests/drracket/module-lang-test-utils.rkt b/collects/tests/drracket/module-lang-test-utils.rkt index 8821109990..093bcc980d 100644 --- a/collects/tests/drracket/module-lang-test-utils.rkt +++ b/collects/tests/drracket/module-lang-test-utils.rkt @@ -70,10 +70,12 @@ (when ints (let ([after-execute-output - (send interactions-text - get-text - (send interactions-text paragraph-start-position 2) - (send interactions-text paragraph-end-position 2))]) + (queue-callback/res + (λ () + (send interactions-text + get-text + (send interactions-text paragraph-start-position 2) + (send interactions-text paragraph-end-position 2))))]) (unless (or (test-all? test) (string=? "> " after-execute-output)) (fprintf (current-error-port) "FAILED (line ~a): ~a\n ~a\n expected no output after execution, got: ~s\n" @@ -87,21 +89,23 @@ (wait-for-computation drs))) (let* ([text - (if (test-all? test) - (let* ([para (- (send interactions-text position-paragraph - (send interactions-text last-position)) - 1)]) - (send interactions-text - get-text - (send interactions-text paragraph-start-position 2) - (send interactions-text paragraph-end-position para))) - (let* ([para (- (send interactions-text position-paragraph - (send interactions-text last-position)) - 1)]) - (send interactions-text - get-text - (send interactions-text paragraph-start-position para) - (send interactions-text paragraph-end-position para))))] + (queue-callback/res + (λ () + (if (test-all? test) + (let* ([para (- (send interactions-text position-paragraph + (send interactions-text last-position)) + 1)]) + (send interactions-text + get-text + (send interactions-text paragraph-start-position 2) + (send interactions-text paragraph-end-position para))) + (let* ([para (- (send interactions-text position-paragraph + (send interactions-text last-position)) + 1)]) + (send interactions-text + get-text + (send interactions-text paragraph-start-position para) + (send interactions-text paragraph-end-position para))))))] [output-passed? (let ([r (test-result test)]) ((cond [(string? r) string=?] [(regexp? r) regexp-match?] @@ -143,14 +147,16 @@ (set-module-language! #f) (test:set-radio-box-item! "Debugging") - (let ([f (get-top-level-focus-window)]) + (let ([f (queue-callback/res (λ () (get-top-level-focus-window)))]) (test:button-push "OK") (wait-for-new-frame f)) (for-each single-test (reverse tests)) (clear-definitions drs) - (send (send drs get-definitions-text) set-modified #f) - (for ([file temp-files]) (when (file-exists? file) (delete-file file)))) + (queue-callback/res (λ () (send (send drs get-definitions-text) set-modified #f))) + (for ([file temp-files]) + (when (file-exists? file) + (delete-file file)))) (define (run-use-compiled-file-paths-tests) diff --git a/collects/tests/drracket/repl-test.rkt b/collects/tests/drracket/repl-test.rkt index 3b9db3164e..a3667087f1 100644 --- a/collects/tests/drracket/repl-test.rkt +++ b/collects/tests/drracket/repl-test.rkt @@ -73,7 +73,7 @@ This produces an ACK message backtrace-image-string " " file-image-string - " .*mred/private/snipfile.rkt:")) + " .*mred[/\\]private[/\\]snipfile.rkt:")) "[0-9]+:[0-9]+: " (regexp-quote str)))) @@ -190,8 +190,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -266,8 +266,8 @@ This produces an ACK message "define-values: cannot change constant variable: +" "define-values: cannot change constant variable: +" "define-values: cannot change constant variable: +" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: define-values: cannot change constant variable: \\+" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: define-values: cannot change constant variable: \\+") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: define-values: cannot change constant variable: \\+" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: define-values: cannot change constant variable: \\+") 'interactions #f void @@ -305,8 +305,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:7: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -350,8 +350,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:2:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -417,8 +417,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:4: reference to undefined identifier: x" "reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x") 'definitions #f void @@ -457,8 +457,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: expt: expected argument of type ; given #" "expt: expected argument of type ; given #" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #") 'definitions #f void @@ -507,8 +507,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: x" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:4: reference to undefined identifier: x" "1\n2\nreference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: x") 'definitions #f void @@ -620,8 +620,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #f\n15" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:5:19: expt: expected argument of type ; given #f\n15" "expt: expected argument of type ; given #f\n15" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f\n15") 'definitions #f void @@ -719,8 +719,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} expt: expected argument of type ; given #f" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:6:15: expt: expected argument of type ; given #f" "expt: expected argument of type ; given #f" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type ; given #f") 'definitions #f void @@ -796,8 +796,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} procedure application: expected procedure, given: 3; arguments were: 3" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:3:13: procedure application: expected procedure, given: 3; arguments were: 3" "procedure application: expected procedure, given: 3; arguments were: 3" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: procedure application: expected procedure, given: 3; arguments were: 3") 'definitions #f void @@ -898,8 +898,8 @@ This produces an ACK message "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: xx" "{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: reference to undefined identifier: xx" "reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" - #rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx" + #rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: reference to undefined identifier: xx") 'definitions #f void @@ -1104,14 +1104,14 @@ This produces an ACK message (define drscheme-frame (wait-for-drscheme-frame)) - (define interactions-text (send drscheme-frame get-interactions-text)) - (define interactions-canvas (send drscheme-frame get-interactions-canvas)) - (define definitions-text (send drscheme-frame get-definitions-text)) - (define definitions-canvas (send drscheme-frame get-definitions-canvas)) - (define execute-button (send drscheme-frame get-execute-button)) + (define interactions-text (queue-callback/res (λ () (send drscheme-frame get-interactions-text)))) + (define interactions-canvas (queue-callback/res (λ () (send drscheme-frame get-interactions-canvas)))) + (define definitions-text (queue-callback/res (λ () (send drscheme-frame get-definitions-text)))) + (define definitions-canvas (queue-callback/res (λ () (send drscheme-frame get-definitions-canvas)))) + (define execute-button (queue-callback/res (λ () (send drscheme-frame get-execute-button)))) (define wait-for-execute (lambda () (wait-for-button execute-button))) - (define get-int-pos (lambda () (get-text-pos interactions-text))) + (define get-int-pos (lambda () (queue-callback/res (λ () (get-text-pos interactions-text))))) (define short-tmp-load-filename @@ -1127,17 +1127,14 @@ This produces an ACK message (clear-definitions drscheme-frame) (type-in-definitions drscheme-frame "1/2") (do-execute drscheme-frame) - (let ([s (make-semaphore 0)]) - (queue-callback - (lambda () - (let* ([start (send interactions-text paragraph-start-position 2)] - ;; since the fraction is supposed to be one char wide, we just - ;; select one char, so that, if the regular number prints out, - ;; this test will fail. - [end (+ start 1)]) - (send interactions-text set-position start end) - (semaphore-post s)))) - (semaphore-wait s)) + (queue-callback/res + (lambda () + (let* ([start (send interactions-text paragraph-start-position 2)] + ;; since the fraction is supposed to be one char wide, we just + ;; select one char, so that, if the regular number prints out, + ;; this test will fail. + [end (+ start 1)]) + (send interactions-text set-position start end)))) (test:menu-select "Edit" "Copy") (clear-definitions drscheme-frame) (type-in-definitions drscheme-frame "(+ ") @@ -1216,7 +1213,7 @@ This produces an ACK message [(send definitions-canvas has-focus?) (let ([start (car source-location)] [finish (cdr source-location)]) - (let* ([error-ranges (send interactions-text get-error-ranges)] + (let* ([error-ranges (queue-callback/res (λ () (send interactions-text get-error-ranges)))] [error-range (and error-ranges (not (null? error-ranges)) (car error-ranges))]) @@ -1407,9 +1404,8 @@ This produces an ACK message (test:keystroke #\return) (wait-for-execute) - (for-each test:keystroke (string->list "x")) - (let ([start (+ 1 (send interactions-text last-position))]) + (let ([start (+ 1 (queue-callback/res (λ () (send interactions-text last-position))))]) (test:keystroke #\return) (wait-for-execute) @@ -1458,7 +1454,7 @@ This produces an ACK message (wait-for-execute) (for-each test:keystroke (string->list (format "(load ~s)" tmp-load-short-filename))) - (let ([start (+ 1 (send interactions-text last-position))]) + (let ([start (+ 1 (queue-callback/res (λ () (send interactions-text last-position))))]) (test:keystroke #\return) (wait-for-execute) (let* ([end (- (get-int-pos) 1)] @@ -1469,7 +1465,7 @@ This produces an ACK message (next-test))) (for-each test:keystroke (string->list "(+ 4 5)")) - (let ([start (+ 1 (send interactions-text last-position))]) + (let ([start (+ 1 (queue-callback/res (λ () (send interactions-text last-position))))]) (test:keystroke #\return) (wait-for-execute) (let* ([end (- (get-int-pos) 1)] diff --git a/collects/tests/drracket/teaching-lang-coverage.rkt b/collects/tests/drracket/teaching-lang-coverage.rkt index fb163ad6c0..363245a72c 100644 --- a/collects/tests/drracket/teaching-lang-coverage.rkt +++ b/collects/tests/drracket/teaching-lang-coverage.rkt @@ -110,7 +110,7 @@ (set-language-level! (list #rx"How to Design Programs" this-lang)))) (clear-definitions drr-frame) - (send definitions-text insert (test-program t)) + (insert-in-definitions drr-frame (test-program t)) (do-execute drr-frame) (let ([result (fetch-output