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

...

Browse Source 
original commit: b997c396c7d8c4f2b8337c2ae0fcdc4000a994a9
This commit is contained in:
Robby Findler 2001-11-01 22:33:56 +00:00
parent bd1dced42e
commit 7e2bc20018
3 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/framework/debug.ss
View File

@ -15,7 +15,7 @@
;; tests that passed and those that failed
(define schedule? #t)
;; of the sexpression transactions between mz and mred
;; all of the sexpression transactions between mz and mred
(define messages? #t)
(syntax-case stx (mr-tcp mz-tcp admin schedule messages)

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

@ -87,7 +87,7 @@
(test
'windows-menu
(lambda (x)
(equal? x (list "test")))
(equal? x (list "Bring frame to front..." #f "test")))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "test")])
@ -96,14 +96,14 @@
(send-sexp-to-mred
'(begin0
(map
(lambda (x) (send x get-label))
(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-unshown
(lambda (x)
(equal? x (list "test")))
(equal? x (list "Bring frame to front..." #f "test")))
(lambda ()
(send-sexp-to-mred
'(let ([frame1 (make-object frame:basic% "test")]
@ -113,14 +113,14 @@
(send-sexp-to-mred
'(begin0
(map
(lambda (x) (send x get-label))
(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 (list "aaa" "bbb")))
(equal? x (list "Bring frame to front..." #f "aaa" "bbb")))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "aaa")])
@ -134,14 +134,14 @@
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(begin0
(map
(lambda (x) (send x get-label))
(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) (send x close)) frames))))))
(test
'windows-menu-sorted2
(lambda (x)
(equal? x (list "aaa" "bbb")))
(equal? x (list "Bring frame to front..." #f "aaa" "bbb")))
(lambda ()
(send-sexp-to-mred
'(let ([frame (make-object frame:basic% "bbb")])
@ -155,6 +155,6 @@
`(let ([frames (send (group:get-the-frame-group) get-frames)])
(begin0
(map
(lambda (x) (send x get-label))
(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) (send x close)) frames)))))))

2
collects/tests/framework/load.ss
View File

@ -36,7 +36,7 @@
(test/load "macro.ss" '(mixin () () ()))
(test/load "framework-unit.ss" '(list framework@ framework-no-prefs@ framework-small-part@))
(test/load "framework-unit.ss" '(list framework@ framework-no-prefs@ frameworkc@))
(test/load "framework.ss" '(list prefs-file:get-preferences-filename
test:button-push
gui-utils:next-untitled-name