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

update MrEd gc test for v4

Browse Source 
svn: r10122

original commit: 6aa847ca67633d24399d0ab6246c4d7b8fa87d50
This commit is contained in:
Matthew Flatt 2008-06-04 11:45:41 +00:00
parent 2f36758ca3
commit 8400ea21b9
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/tests/mred/mem.ss
View File

@ -39,7 +39,7 @@
(define permanent-ready? #f) (define permanent-ready? #f)
(define mb-lock (make-semaphore 1)) (define mb-lock (make-semaphore 1))
(define htw (make-hash-table 'weak)) (define htw (make-weak-hasheq))
(send sub-collect-frame show #t) (send sub-collect-frame show #t)
@ -95,7 +95,7 @@
(sequence (apply super-init args))))) (sequence (apply super-init args)))))
start 100)) start 100))
(if frame? (when frame?
(let* ([f (remember tag (let* ([f (remember tag
(make-object (if (even? n) (make-object (if (even? n)
frame% frame%
@ -121,7 +121,7 @@
(remember tag (make-object button% "two" p cb)) (remember tag (make-object button% "two" p cb))
(send f show #f))) (send f show #f)))
(if subwindows? (when subwindows?
(let ([p (make-object (get-panel% n) sub-collect-frame)] (let ([p (make-object (get-panel% n) sub-collect-frame)]
[cv (make-object canvas% sub-collect-frame)] [cv (make-object canvas% sub-collect-frame)]
[add-objects [add-objects
@ -152,7 +152,7 @@
(send sub-collect-frame delete-child p) (send sub-collect-frame delete-child p)
(send sub-collect-frame delete-child cv))) (send sub-collect-frame delete-child cv)))
(if (and edit? insert?) (when (and edit? insert?)
(let ([e edit]) (let ([e edit])
(when load-file? (when load-file?
(send e load-file (build-path source-dir "mem.ss"))) (send e load-file (build-path source-dir "mem.ss")))
@ -203,7 +203,7 @@
(remember (cons tag m) (make-object point% n m)) (remember (cons tag m) (make-object point% n m))
(let ([br (make-object brush%)]) (let ([br (make-object brush%)])
(remember (cons tag m) br) (remember (cons tag m) br)
(hash-table-put! htw br 'ok)) (hash-set! htw br 'ok))
(remember (cons tag m) (make-object pen%)) (remember (cons tag m) (make-object pen%))
(loop (sub1 m))))) (loop (sub1 m)))))
@ -228,8 +228,8 @@
(define (still) (define (still)
(map (lambda (x) (map (lambda (x)
(let ([v (weak-box-value (cdr x))]) (let ([v (weak-box-value (cdr x))])
(if v (when v
(printf "~s ~s~n" (car x) v)))) (printf "~s ~s~n" (car x) v))))
allocated) allocated)
(void)) (void))