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
(require "test-suite-utils.ss")
#lang mzscheme
(require "test-suite-utils.ss")
; mem-boxes : (list-of (list string (list-of (weak-box TST))))
(send-sexp-to-mred '(define mem-boxes null))
; mem-boxes : (list-of (list string (list-of (weak-box TST))))
(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
`(let ([new-boxes
(let loop ([n ,mem-count])
@ -31,7 +31,7 @@
(sleep/yield 1/10) (collect-garbage)
(set! mem-boxes (cons (list ,tag new-boxes) mem-boxes)))))
(define (done)
(define (done)
(send-sexp-to-mred
`(begin
(yield) (collect-garbage)
@ -110,11 +110,12 @@
(make-object button% "Close" vp (lambda (x y) (send f show #f)))
(send f show #t)))))
(define (test-frame-allocate %)
(define (test-frame-allocate %)
(let ([name (format "~s" %)])
(send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #f))
(test-allocate name
`(lambda () (let ([f (make-object ,% ,name)])
`(lambda ()
(let ([f (make-object ,% ,name)])
(send f show #t)
(yield) (yield)
f))
@ -126,48 +127,48 @@
(yield) (yield)))
(send-sexp-to-mred '(preferences:set 'framework:exit-when-no-frames #t))))
(test-allocate "frame%"
'(lambda () (let ([f (make-object frame% "test frame")])
(test-allocate "frame%"
'(lambda ()
(let ([f (make-object frame% "test frame")])
(send f show #t)
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)
`(lambda () (make-object ,object-name))
'(lambda (e) (send e on-close))))
(test-editor-allocate 'text:basic%)
(test-editor-allocate 'text:keymap%)
(test-editor-allocate 'text:autowrap%)
(test-editor-allocate 'text:file%)
(test-editor-allocate 'text:clever-file-format%)
(test-editor-allocate 'text:backup-autosave%)
(test-editor-allocate 'text:searching%)
(test-editor-allocate 'text:info%)
(test-editor-allocate 'text:basic%)
(test-editor-allocate 'text:keymap%)
(test-editor-allocate 'text:autowrap%)
(test-editor-allocate 'text:file%)
(test-editor-allocate 'text:clever-file-format%)
(test-editor-allocate 'text:backup-autosave%)
(test-editor-allocate 'text:searching%)
(test-editor-allocate 'text:info%)
(test-editor-allocate 'pasteboard:basic%)
(test-editor-allocate 'pasteboard:keymap%)
(test-editor-allocate 'pasteboard:file%)
(test-editor-allocate 'pasteboard:backup-autosave%)
(test-editor-allocate 'pasteboard:info%)
(test-editor-allocate 'pasteboard:basic%)
(test-editor-allocate 'pasteboard:keymap%)
(test-editor-allocate 'pasteboard:file%)
(test-editor-allocate 'pasteboard:backup-autosave%)
(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 (t) (void)))
(test-frame-allocate '(class frame% (inherit show) (define/public (close) (show #f)) (super-new)))
(test-frame-allocate 'frame:basic%)
(test-frame-allocate 'frame:info%)
(test-frame-allocate 'frame:text-info%)
(test-frame-allocate 'frame:pasteboard-info%)
(test-frame-allocate 'frame:standard-menus%)
(test-frame-allocate '(class frame% (inherit show) (define/public (close) (show #f)) (super-new)))
(test-frame-allocate 'frame:basic%)
(test-frame-allocate 'frame:info%)
(test-frame-allocate 'frame:text-info%)
(test-frame-allocate 'frame:pasteboard-info%)
(test-frame-allocate 'frame:standard-menus%)
(test-frame-allocate 'frame:text%)
(test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:text%)
(test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:pasteboard%)
(done))
(test-frame-allocate 'frame:pasteboard%)
(done)