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

found another place in the framework test suite where operations weren't happening on the eventspace handler thread

Browse Source
This commit is contained in:
Robby Findler 2011-01-17 15:35:35 -06:00
parent ff800c997e
commit 70e3074baf
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/framework/keys.rkt
View File

@ -282,15 +282,20 @@
[end-expect (buff-spec-end after)]) [end-expect (buff-spec-end after)])
(test (list key-sequence i) (test (list key-sequence i)
(lambda (x) (equal? x (vector text-expect start-expect end-expect))) (lambda (x) (equal? x (vector text-expect start-expect end-expect)))
`(let* ([text (send (get-top-level-focus-window) get-editor)]) `(let* ([qc (λ (t) (let ([c (make-channel)])
(send text erase) (queue-callback (λ () (channel-put c (t))))
(send text insert ,(buff-spec-string before)) (channel-get c)))]
(send text set-position ,(buff-spec-start before) ,(buff-spec-end before)) [text (qc (λ () (send (get-top-level-focus-window) get-editor)))])
(qc (λ ()
(send text erase)
(send text insert ,(buff-spec-string before))
(send text set-position ,(buff-spec-start before) ,(buff-spec-end before))))
,@(map (lambda (key) `(test:keystroke ',(car key) ',(cdr key))) ,@(map (lambda (key) `(test:keystroke ',(car key) ',(cdr key)))
key-sequence) key-sequence)
(vector (send text get-text) (qc (λ ()
(send text get-start-position) (vector (send text get-text)
(send text get-end-position))))))]) (send text get-start-position)
(send text get-end-position))))))))])
(for-each process-key-sequence key-sequences))) (for-each process-key-sequence key-sequences)))