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

fix group-test

Browse Source 
merge to release branch, please

original commit: 975426f00c2886c8bd1d933d2f84706744027942
This commit is contained in:
Robby Findler 2012-10-17 20:18:46 -05:00
parent 59e40964d8
commit 22535c00df
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/tests/framework/group-test.rkt
View File

@ -100,19 +100,19 @@
'windows-menu 'windows-menu
(lambda (x) (lambda (x)
(equal? x (append windows-menu-prefix (list "first" "test")))) (equal? x (append windows-menu-prefix (list "first" "test"))))
(lambda () (λ ()
(queue-sexp-to-mred (queue-sexp-to-mred
'(let ([frame (make-object frame:basic% "test")]) '(let ([frame (make-object frame:basic% "test")])
(send frame show #t))) (send frame show #t)))
(wait-for-frame "test") (wait-for-frame "test")
(queue-sexp-to-mred (queue-sexp-to-mred
'(begin0 (map (lambda (x) '(let ([mb (send (get-top-level-focus-window) get-menu-bar)])
(and (is-a? x labelled-menu-item<%>) (send x get-label))) (send mb on-demand)
(send (car* (send (send (get-top-level-focus-window) (define labels
get-menu-bar) (for/list ([x (send (car* (send mb get-items)) get-items)])
get-items)) (and (is-a? x labelled-menu-item<%>) (send x get-label))))
get-items)) (send (get-top-level-focus-window) close)
(send (get-top-level-focus-window) close))))) labels))))
(test (test
'windows-menu-unshown 'windows-menu-unshown
@ -125,13 +125,13 @@
(send frame1 show #t))) (send frame1 show #t)))
(wait-for-frame "test") (wait-for-frame "test")
(queue-sexp-to-mred (queue-sexp-to-mred
'(begin0 (map (lambda (x) '(let ([mb (send (get-top-level-focus-window) get-menu-bar)])
(and (is-a? x labelled-menu-item<%>) (send x get-label))) (send mb on-demand)
(send (car* (send (send (get-top-level-focus-window) (define items
get-menu-bar) (for/list ([x (send (car* (send mb get-items)) get-items)])
get-items)) (and (is-a? x labelled-menu-item<%>) (send x get-label))))
get-items)) (send (get-top-level-focus-window) close)
(send (get-top-level-focus-window) close))))) items))))
(test (test
'windows-menu-sorted1 'windows-menu-sorted1
@ -148,10 +148,11 @@
(wait-for-frame "bbb") (wait-for-frame "bbb")
(queue-sexp-to-mred (queue-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)]) `(let ([frames (send (group:get-the-frame-group) get-frames)])
(define mb (send (car* frames) get-menu-bar))
(send mb on-demand)
(begin0 (map (lambda (x) (begin0 (map (lambda (x)
(and (is-a? x labelled-menu-item<%>) (send x get-label))) (and (is-a? x labelled-menu-item<%>) (send x get-label)))
(send (car* (send (send (car* frames) get-menu-bar) (send (car* (send mb get-items))
get-items))
get-items)) get-items))
(for-each (lambda (x) (for-each (lambda (x)
(unless (equal? (send x get-label) "first") (unless (equal? (send x get-label) "first")
@ -173,13 +174,13 @@
(wait-for-frame "aaa") (wait-for-frame "aaa")
(queue-sexp-to-mred (queue-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)]) `(let ([frames (send (group:get-the-frame-group) get-frames)])
(define mb (send (car* frames) get-menu-bar))
(send mb on-demand)
(begin0 (map (lambda (x) (begin0 (map (lambda (x)
(and (is-a? x labelled-menu-item<%>) (send x get-label))) (and (is-a? x labelled-menu-item<%>) (send x get-label)))
(send (car* (send (send (car* frames) get-menu-bar) (send (car* (send mb get-items))
get-items))
get-items)) get-items))
(for-each (lambda (x) (for-each (lambda (x)
(unless (equal? (send x get-label) "first") (unless (equal? (send x get-label) "first")
(send x close))) (send x close)))
frames)))))) frames)))))))
)