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

avoid doing mac os x-specific tests unless under mac os x

Browse Source 
svn: r18154
This commit is contained in:
Robby Findler 2010-02-18 20:36:03 +00:00
parent 202c056c53
commit 8424dea37b
1 changed files with 88 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

173
collects/tests/framework/group-test.ss
View File

@ -5,14 +5,14 @@
(let ([basics (list "Bring Frame to Front..." "Most Recent Window" (let ([basics (list "Bring Frame to Front..." "Most Recent Window"
#f)]) #f)])
(if (eq? (system-type) 'macosx) (if (eq? (system-type) 'macosx)
(list* "Minimize" "Zoom" basics) (list* "Minimize" "Zoom" basics)
basics))) basics)))
(send-sexp-to-mred (send-sexp-to-mred
'(define-syntax car* '(define-syntax car*
(syntax-rules () (syntax-rules ()
[(car* x) (if (pair? x) [(car* x) (if (pair? x)
(car x) (car x)
(error 'car* "got a non-pair for ~s" 'x))]))) (error 'car* "got a non-pair for ~s" 'x))])))
;; this test uses a new eventspace so that the mred function ;; this test uses a new eventspace so that the mred function
;; current-eventspace-has-standard-menus? returns #f and thus ;; current-eventspace-has-standard-menus? returns #f and thus
@ -54,7 +54,7 @@
(send-sexp-to-mred (send-sexp-to-mred
`(begin0 (map (lambda (x) (send x get-label)) `(begin0 (map (lambda (x) (send x get-label))
(send (group:get-the-frame-group) get-frames)) (send (group:get-the-frame-group) get-frames))
(send (get-top-level-focus-window) close))))) (send (get-top-level-focus-window) close)))))
(test (test
'two-frames-registered 'two-frames-registered
@ -94,89 +94,92 @@
frames) frames)
(map (lambda (x) (send x get-label)) frames))))) (map (lambda (x) (send x get-label)) frames)))))
(test (when (eq? (system-type) 'macosx)
'windows-menu
(lambda (x) (test
(equal? x (append windows-menu-prefix (list "first" "test")))) 'windows-menu
(lambda () (lambda (x)
(send-sexp-to-mred (equal? x (append windows-menu-prefix (list "first" "test"))))
'(let ([frame (make-object frame:basic% "test")]) (lambda ()
(send frame show #t))) (send-sexp-to-mred
(wait-for-frame "test") '(let ([frame (make-object frame:basic% "test")])
(send-sexp-to-mred (send frame show #t)))
'(begin0 (map (lambda (x) (wait-for-frame "test")
(and (is-a? x labelled-menu-item<%>) (send x get-label))) (send-sexp-to-mred
(send (car* (send (send (get-top-level-focus-window) '(begin0 (map (lambda (x)
get-menu-bar)
get-items))
get-items))
(send (get-top-level-focus-window) close)))))
(test
'windows-menu-unshown
(lambda (x)
(equal? x (append windows-menu-prefix (list "first" "test"))))
(lambda ()
(send-sexp-to-mred
'(let ([frame1 (make-object frame:basic% "test")]
[frame2 (make-object frame:basic% "test-not-shown")])
(send frame1 show #t)))
(wait-for-frame "test")
(send-sexp-to-mred
'(begin0 (map (lambda (x)
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
(send (car* (send (send (get-top-level-focus-window)
get-menu-bar)
get-items))
get-items))
(send (get-top-level-focus-window) close)))))
(test
'windows-menu-sorted1
(lambda (x)
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "aaa")])
(send frame show #t)))
(wait-for-frame "aaa")
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "bbb")])
(send frame show #t)))
(wait-for-frame "bbb")
(send-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(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 (send (get-top-level-focus-window)
get-menu-bar)
get-items)) get-items))
get-items)) get-items))
(for-each (lambda (x) (send (get-top-level-focus-window) close)))))
(unless (equal? (send x get-label) "first")
(send x close))) (test
frames)))))) 'windows-menu-unshown
(lambda (x)
(test (equal? x (append windows-menu-prefix (list "first" "test"))))
'windows-menu-sorted2 (lambda ()
(lambda (x) (send-sexp-to-mred
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first")))) '(let ([frame1 (make-object frame:basic% "test")]
(lambda () [frame2 (make-object frame:basic% "test-not-shown")])
(send-sexp-to-mred (send frame1 show #t)))
'(let ([frame (make-object frame:basic% "bbb")]) (wait-for-frame "test")
(send frame show #t))) (send-sexp-to-mred
(wait-for-frame "bbb") '(begin0 (map (lambda (x)
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "aaa")])
(send frame show #t)))
(wait-for-frame "aaa")
(send-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(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 (send (get-top-level-focus-window)
get-menu-bar)
get-items)) get-items))
get-items)) get-items))
(for-each (lambda (x) (send (get-top-level-focus-window) close)))))
(unless (equal? (send x get-label) "first")
(send x close))) (test
frames)))))) 'windows-menu-sorted1
(lambda (x)
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "aaa")])
(send frame show #t)))
(wait-for-frame "aaa")
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "bbb")])
(send frame show #t)))
(wait-for-frame "bbb")
(send-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(begin0 (map (lambda (x)
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
(send (car* (send (send (car* frames) get-menu-bar)
get-items))
get-items))
(for-each (lambda (x)
(unless (equal? (send x get-label) "first")
(send x close)))
frames))))))
(test
'windows-menu-sorted2
(lambda (x)
(equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "bbb")])
(send frame show #t)))
(wait-for-frame "bbb")
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "aaa")])
(send frame show #t)))
(wait-for-frame "aaa")
(send-sexp-to-mred
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(begin0 (map (lambda (x)
(and (is-a? x labelled-menu-item<%>) (send x get-label)))
(send (car* (send (send (car* frames) get-menu-bar)
get-items))
get-items))
(for-each (lambda (x)
(unless (equal? (send x get-label) "first")
(send x close)))
frames))))))
)