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

...

Browse Source 
original commit: b6a0c23aa0cbbb2b5463caff957d6cfccee5bd79
This commit is contained in:
Robby Findler 2001-02-09 04:52:42 +00:00
parent 19bb2f901f
commit ce531fdbb9
1 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,4 +1,4 @@
;; (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)
@ -14,20 +14,20 @@
[b (make-weak-box o)]) [b (make-weak-box o)])
(,close o) (,close o)
(cons b (loop (- n 1))))]))]) (cons b (loop (- n 1))))]))])
(collect-garbage) (sleep/yield 1/10) (collect-garbage)
(collect-garbage) (sleep/yield 1/10) (collect-garbage)
(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
(collect-garbage) (yield) (collect-garbage)
(collect-garbage) (yield) (collect-garbage)
(collect-garbage) (yield) (collect-garbage)
(collect-garbage) (yield) (collect-garbage)
(collect-garbage) (yield) (collect-garbage)
(collect-garbage) (yield) (collect-garbage)
(let ([f (make-object dialog% "Results")] (let ([f (make-object dialog% "Results")]
[anything? #f]) [anything? #f])
(for-each (for-each
@ -39,12 +39,10 @@
(foldl (lambda (b n) (if (weak-box-value b) (+ n 1) n)) (foldl (lambda (b n) (if (weak-box-value b) (+ n 1) n))
0 0
boxes))]) boxes))])
(let loop ([tries 4]) (let loop ([tries 16])
(unless (zero? tries) (unless (zero? tries)
(when (> (calc-results) 0) (when (> (calc-results) 0)
(collect-garbage) (yield) (yield) (sleep/yield 1/5) (collect-garbage)
(collect-garbage)
(collect-garbage)
(loop (- tries 1))))) (loop (- tries 1)))))
(let ([res (calc-results)]) (let ([res (calc-results)])
(when (> res 0) (when (> res 0)
@ -67,6 +65,8 @@
`(lambda (f) `(lambda (f)
(yield) (yield) (yield) (yield)
(send f close) (send f close)
(when (send f is-shown?)
(error 'test-frame-allocate "~a instance didn't close" ',%))
(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))))
@ -110,11 +110,10 @@
(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:text-info-file%) ;(test-frame-allocate 'frame:text-info-file%)
(test-frame-allocate 'frame:searchable%) ;(test-frame-allocate 'frame:searchable%)
(test-frame-allocate 'frame:pasteboard%) ;(test-frame-allocate 'frame:pasteboard%)
(test-frame-allocate 'frame:pasteboard-info-file%) ;(test-frame-allocate 'frame:pasteboard-info-file%)
(done) (done)