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

adjust the leak test so that it first runs with online

Browse Source 
compilation disabled and then runs with it enabled
This commit is contained in:
Robby Findler 2012-08-13 09:21:52 -05:00
parent 35afcc89ba
commit e6fc56a8b8
2 changed files with 83 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/tests/drracket/no-write-and-frame-leak.rkt
View File

@ -29,12 +29,20 @@ This test checks:
void
void)])
(fire-up-drracket-and-run-tests
#:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f])
(λ ()
(check-menus (wait-for-drracket-frame))
(try-to-find-leak "online compilation disabled:")
(preferences:set 'drracket:online-compilation-default-on #t)
(try-to-find-leak "online compilation enabled:")))))
(define (try-to-find-leak online-compilation-string)
(define drs-frame1 (wait-for-drracket-frame))
(sync (system-idle-evt))
(check-menus drs-frame1)
(for ([tries (in-range 3)])
(test:menu-select "File" "New Tab")
(sync (system-idle-evt))
@ -64,13 +72,13 @@ This test checks:
(cond
[(zero? n)
(when (weak-box-value drs-tabb)
(eprintf "frame leak!\n"))
(eprintf "~a frame leak!\n" online-compilation-string))
(when (weak-box-value drs-frame2b)
(eprintf "tab leak!\n"))
(eprintf "~a tab leak!\n" online-compilation-string))
(when (weak-box-value tab-nsb)
(eprintf "tab namespace leak!\n"))
(eprintf "~a tab namespace leak!\n" online-compilation-string))
(when (weak-box-value frame2-nsb)
(eprintf "frame namespace leak!\n"))]
(eprintf "~a frame namespace leak!\n" online-compilation-string))]
[else
(collect-garbage) (sync (system-idle-evt))
(when (ormap weak-box-value
@ -78,7 +86,7 @@ This test checks:
tab-nsb
drs-frame2b
frame2-nsb))
(loop (- n 1)))])))))))
(loop (- n 1)))]))))
(define (check-menus frame)

37
collects/tests/drracket/private/drracket-test-util.rkt
View File

@ -601,12 +601,16 @@
;; but just to print and return.
(define orig-display-handler (error-display-handler))
(define (fire-up-drracket-and-run-tests #:use-focus-table? [use-focus-table? #t] run-test)
(define (fire-up-drracket-and-run-tests
#:use-focus-table? [use-focus-table? #t]
#:prefs [prefs '()]
run-test)
(on-eventspace-handler-thread 'fire-up-drracket-and-run-tests)
(let ()
(use-hash-for-prefs fw:preferences:low-level-get-preference
fw:preferences:low-level-put-preferences
fw:preferences:restore-defaults)
fw:preferences:restore-defaults
prefs)
(parameterize ([current-command-line-arguments #()])
(dynamic-require 'drracket #f))
@ -654,7 +658,8 @@
(λ ()
(use-hash-for-prefs (dynamic-require 'framework 'preferences:low-level-get-preference)
(dynamic-require 'framework 'preferences:low-level-put-preferences)
(dynamic-require 'framework 'preferences:restore-defaults))
(dynamic-require 'framework 'preferences:restore-defaults)
'())
(dynamic-require 'drracket #f)
(thread (λ ()
(run-test)
@ -664,23 +669,37 @@
(define (use-hash-for-prefs preferences:low-level-get-preference
preferences:low-level-put-preferences
preferences:restore-defaults)
preferences:restore-defaults
prefs)
;; change the preferences system so that it doesn't write to
;; a file; partly to avoid problems of concurrency in drdr
;; but also to make the test suite easier for everyone to run.
(let ([prefs-table (make-hash)])
(preferences:low-level-put-preferences
(lambda (names vals)
(for-each (lambda (name val) (hash-set! prefs-table name val))
names vals)))
(λ (names vals)
(for ([name (in-list names)]
[val (in-list vals)])
(hash-set! prefs-table name val))))
(preferences:low-level-get-preference
(lambda (name [fail (lambda () #f)])
(λ (name [fail (lambda () #f)])
(hash-ref prefs-table name fail)))
;; set all preferences to their defaults (some pref values may have
;; been read by this point, but hopefully that won't affect the
;; startup of drracket)
(preferences:restore-defaults)))
(preferences:restore-defaults)
;; initialize some preferences to simulate these
;; being saved already in the user's prefs file
(for ([pref (in-list prefs)])
(define pref-key (list-ref pref 0))
(define pref-val (list-ref pref 1))
(unless (regexp-match #rx"^plt:framework-pref:" (symbol->string pref-key))
;; this currently doesn't happen, and it is easy to forget
;; that prefix, so print a message here to remind
(printf "WARNING: setting a preference that isn't set via the framework: ~s\n"
pref-key))
(hash-set! prefs-table pref-key pref-val))))
(define (not-on-eventspace-handler-thread fn)
(when (eq? (current-thread) (eventspace-handler-thread (current-eventspace)))