Added a logger to drdr for tracking drracket's memory use on startup
This commit is contained in:
parent
e05cbae2af
commit
b4d176466a
|
@ -1370,6 +1370,7 @@ path/s is either such a string or a list of them.
|
|||
"collects/tests/drracket/drracket-test-util.rkt" drdr:command-line (gracket "-t" *)
|
||||
"collects/tests/drracket/io.rkt" drdr:command-line (gracket *)
|
||||
"collects/tests/drracket/language-test.rkt" drdr:command-line (gracket *) drdr:timeout 600
|
||||
"collects/tests/drracket/memory-log.rkt" drdr:command-line (gracket *)
|
||||
"collects/tests/drracket/module-lang-test-utils.rkt" drdr:command-line (gracket-text "-t" *)
|
||||
"collects/tests/drracket/module-lang-test.rkt" drdr:command-line (gracket *) drdr:timeout 120
|
||||
"collects/tests/drracket/randomly-click-language-dialog.rkt" drdr:command-line (mzc *)
|
||||
|
|
28
collects/tests/drracket/memory-log.rkt
Normal file
28
collects/tests/drracket/memory-log.rkt
Normal file
|
@ -0,0 +1,28 @@
|
|||
#lang racket/base
|
||||
(require "drracket-test-util.rkt"
|
||||
racket/gui/base)
|
||||
|
||||
;; mem-cnt returns the amount of memory used, iterating (collect-garbage)
|
||||
;; until the delta is less than 10k or we've done it 20 times.
|
||||
(define (mem-cnt)
|
||||
(let loop ([cmu (current-memory-use)]
|
||||
[n 20])
|
||||
(collect-garbage)
|
||||
(let ([new-cmu (current-memory-use)])
|
||||
(cond
|
||||
[(or (< n 0)
|
||||
(< (abs (- cmu new-cmu))
|
||||
(* 10 1024)))
|
||||
new-cmu]
|
||||
[else
|
||||
(loop new-cmu (- n 1))]))))
|
||||
|
||||
(fire-up-drscheme-and-run-tests
|
||||
(λ ()
|
||||
(let ([drscheme-frame (wait-for-drscheme-frame)]
|
||||
[s (make-semaphore 0)])
|
||||
(queue-callback (λ () (queue-callback (λ () (semaphore-post s)) #f)) #f)
|
||||
(yield s) ;; let two rounds of pending events be handled.
|
||||
(let ([n (mem-cnt)])
|
||||
(printf "cpu time: ~a real time: ~a gc time: ~a\n"
|
||||
n n n)))))
|
Loading…
Reference in New Issue
Block a user