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

reformat

Browse Source 
svn: r9737
This commit is contained in:
Eli Barzilay 2008-05-08 13:13:02 +00:00
parent 68a266599d
commit fc3115d6bc
1 changed files with 171 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/tests/framework/mem.ss
View File

@ -1,12 +1,12 @@
(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))))
(send-sexp-to-mred '(define mem-boxes null)) (send-sexp-to-mred '(define mem-boxes null))
(define mem-count 10) (define mem-count 10)
(define (test-allocate tag open close) (define (test-allocate tag open close)
(send-sexp-to-mred (send-sexp-to-mred
`(let ([new-boxes `(let ([new-boxes
(let loop ([n ,mem-count]) (let loop ([n ,mem-count])
@ -31,7 +31,7 @@
(sleep/yield 1/10) (collect-garbage) (sleep/yield 1/10) (collect-garbage)
(set! mem-boxes (cons (list ,tag new-boxes) mem-boxes))))) (set! mem-boxes (cons (list ,tag new-boxes) mem-boxes)))))
(define (done) (define (done)
(send-sexp-to-mred (send-sexp-to-mred
`(begin `(begin
(yield) (collect-garbage) (yield) (collect-garbage)
@ -110,11 +110,12 @@
(make-object button% "Close" vp (lambda (x y) (send f show #f))) (make-object button% "Close" vp (lambda (x y) (send f show #f)))
(send f show #t))))) (send f show #t)))))
(define (test-frame-allocate %) (define (test-frame-allocate %)
(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))
@ -126,48 +127,48 @@
(yield) (yield))) (yield) (yield)))
(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))
'(lambda (e) (send e on-close)))) '(lambda (e) (send e on-close))))
(test-editor-allocate 'text:basic%) (test-editor-allocate 'text:basic%)
(test-editor-allocate 'text:keymap%) (test-editor-allocate 'text:keymap%)
(test-editor-allocate 'text:autowrap%) (test-editor-allocate 'text:autowrap%)
(test-editor-allocate 'text:file%) (test-editor-allocate 'text:file%)
(test-editor-allocate 'text:clever-file-format%) (test-editor-allocate 'text:clever-file-format%)
(test-editor-allocate 'text:backup-autosave%) (test-editor-allocate 'text:backup-autosave%)
(test-editor-allocate 'text:searching%) (test-editor-allocate 'text:searching%)
(test-editor-allocate 'text:info%) (test-editor-allocate 'text:info%)
(test-editor-allocate 'pasteboard:basic%) (test-editor-allocate 'pasteboard:basic%)
(test-editor-allocate 'pasteboard:keymap%) (test-editor-allocate 'pasteboard:keymap%)
(test-editor-allocate 'pasteboard:file%) (test-editor-allocate 'pasteboard:file%)
(test-editor-allocate 'pasteboard:backup-autosave%) (test-editor-allocate 'pasteboard:backup-autosave%)
(test-editor-allocate 'pasteboard:info%) (test-editor-allocate 'pasteboard:info%)
(test-editor-allocate 'scheme:text%) (test-editor-allocate 'scheme:text%)
(test-allocate "text:return%" (test-allocate "text:return%"
'(lambda () (make-object text:return% void)) '(lambda () (make-object text:return% void))
'(lambda (t) (void))) '(lambda (t) (void)))
(test-frame-allocate '(class frame% (inherit show) (define/public (close) (show #f)) (super-new))) (test-frame-allocate '(class frame% (inherit show) (define/public (close) (show #f)) (super-new)))
(test-frame-allocate 'frame:basic%) (test-frame-allocate 'frame:basic%)
(test-frame-allocate 'frame:info%) (test-frame-allocate 'frame:info%)
(test-frame-allocate 'frame:text-info%) (test-frame-allocate 'frame:text-info%)
(test-frame-allocate 'frame:pasteboard-info%) (test-frame-allocate 'frame:pasteboard-info%)
(test-frame-allocate 'frame:standard-menus%) (test-frame-allocate 'frame:standard-menus%)
(test-frame-allocate 'frame:text%) (test-frame-allocate 'frame:text%)
(test-frame-allocate 'frame:searchable%) (test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:pasteboard%) (test-frame-allocate 'frame:pasteboard%)
(done)) (done)