svn: r9737
This commit is contained in:
Eli Barzilay 2008-05-08 13:13:02 +00:00
parent 68a266599d
commit fc3115d6bc

View File

@ -1,4 +1,4 @@
(module mem mzscheme #lang mzscheme
(require "test-suite-utils.ss") (require "test-suite-utils.ss")
; mem-boxes : (list-of (list string (list-of (weak-box TST)))) ; mem-boxes : (list-of (list string (list-of (weak-box TST))))
@ -114,7 +114,8 @@
(let ([name (format "~s" %)]) (let ([name (format "~s" %)])
(send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #f)) (send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #f))
(test-allocate name (test-allocate name
`(lambda () (let ([f (make-object ,% ,name)]) `(lambda ()
(let ([f (make-object ,% ,name)])
(send f show #t) (send f show #t)
(yield) (yield) (yield) (yield)
f)) f))
@ -127,12 +128,12 @@
(send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #t)))) (send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #t))))
(test-allocate "frame%" (test-allocate "frame%"
'(lambda () (let ([f (make-object frame% "test frame")]) '(lambda ()
(let ([f (make-object frame% "test frame")])
(send f show #t) (send f show #t)
f)) f))
'(lambda (f) (send f show #f))) '(lambda (f) (send f show #f)))
(define (test-editor-allocate object-name) (define (test-editor-allocate object-name)
(test-allocate (symbol->string object-name) (test-allocate (symbol->string object-name)
`(lambda () (make-object ,object-name)) `(lambda () (make-object ,object-name))
@ -170,4 +171,4 @@
(test-frame-allocate 'frame:searchable%) (test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:pasteboard%) (test-frame-allocate 'frame:pasteboard%)
(done)) (done)