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.
This commit is contained in:
Robby Findler
parent
45f66c3816
commit
fb25dc9a42
|
|
@ -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?)
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <number>; given #<void>"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:1:0: expt: expected argument of type <number>; given #<void>"
|
||||
"expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #<void>")
|
||||
'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 <number>; given #f\n15"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:5:19: expt: expected argument of type <number>; given #f\n15"
|
||||
"expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f\n15"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; 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 <number>; given #f"
|
||||
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:6:15: expt: expected argument of type <number>; given #f"
|
||||
"expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred/private/snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f")
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; given #f"
|
||||
#rx"{stop-multi.png} {stop-22x22.png} .*mred[/\\]private[/\\]snipfile.rkt:[0-9]+:[0-9]+: expt: expected argument of type <number>; 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)]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user