Added a logger to drdr for tracking drracket's memory use on startup

This commit is contained in:
Robby Findler 2010-06-30 07:15:24 -05:00
parent e05cbae2af
commit b4d176466a
2 changed files with 29 additions and 0 deletions

View File

@ -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 *)

View 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)))))