suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make test-engine tests work with new gracket.

Browse Source
This commit is contained in:
Mike Sperber 2011-01-15 12:25:39 +01:00
parent db8e16bc66
commit d2aa1c1138
1 changed files with 23 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/drracket/test-engine-test.rkt
View File

@ -325,8 +325,8 @@
#:check-failures-expected (check-failures-expected '()) #:check-failures-expected (check-failures-expected '())
#:signature-violations-expected (signature-violations-expected '())) #:signature-violations-expected (signature-violations-expected '()))
(let* ([drs (wait-for-drscheme-frame)] (let* ([drs (wait-for-drscheme-frame)]
[interactions-text (send drs get-interactions-text)] [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))]
[definitions-text (send drs get-definitions-text)] [definitions-text (queue-callback/res (λ () (send drs get-definitions-text)))]
[handle-insertion [handle-insertion
(lambda (item) (lambda (item)
(cond (cond
@ -367,9 +367,11 @@
(let ([got (let ([got
(fetch-output (fetch-output
drs drs
(send interactions-text paragraph-start-position 2) (queue-callback/res (λ () (send interactions-text paragraph-start-position 2)))
(queue-callback/res
(λ ()
(send interactions-text paragraph-end-position (send interactions-text paragraph-end-position
(- (send interactions-text last-paragraph) 1)))]) (- (send interactions-text last-paragraph) 1)))))])
(when (regexp-match re:out-of-sync got) (when (regexp-match re:out-of-sync got)
(error 'test-expression "got out of sync message")) (error 'test-expression "got out of sync message"))
(unless (check-expectation defs-expected got) (unless (check-expectation defs-expected got)
@ -406,27 +408,28 @@
(length check-failures-expected) (length signature-violations-expected))))) (length check-failures-expected) (length signature-violations-expected)))))
; #### do same for REPL ; #### do same for REPL
(let ([s (make-semaphore 0)]) (queue-callback/res
(queue-callback
(λ () (λ ()
(send definitions-text select-all) (send definitions-text select-all)
(send definitions-text copy) (send definitions-text copy)
(send interactions-text set-position (send interactions-text set-position
(send interactions-text last-position) (send interactions-text last-position)
(send interactions-text last-position)) (send interactions-text last-position))
(send interactions-text paste) (send interactions-text paste)))
(semaphore-post s)))
(semaphore-wait s))
(let ([last-para (send interactions-text last-paragraph)]) (let ([last-para (queue-callback/res (lambda () (send interactions-text last-paragraph)))])
(alt-return-in-interactions drs) (alt-return-in-interactions drs)
(wait-for-computation drs) (wait-for-computation drs)
(let ([got (let ([got
(fetch-output (fetch-output
drs drs
(send interactions-text paragraph-start-position (+ last-para 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 paragraph-end-position
(- (send interactions-text last-paragraph) 1)))]) (- (send interactions-text last-paragraph) 1)))))])
(when (regexp-match re:out-of-sync got) (when (regexp-match re:out-of-sync got)
(error 'test-expression "got out of sync message")) (error 'test-expression "got out of sync message"))
(unless (check-expectation repl-expected got) (unless (check-expectation repl-expected got)