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

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

@ -29,57 +29,65 @@ This test checks:
void void
void)]) void)])
(fire-up-drracket-and-run-tests (fire-up-drracket-and-run-tests
#:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f])
(λ () (λ ()
(define drs-frame1 (wait-for-drracket-frame)) (check-menus (wait-for-drracket-frame))
(sync (system-idle-evt))
(check-menus drs-frame1) (try-to-find-leak "online compilation disabled:")
(for ([tries (in-range 3)]) (preferences:set 'drracket:online-compilation-default-on #t)
(test:menu-select "File" "New Tab")
(sync (system-idle-evt)) (try-to-find-leak "online compilation enabled:")))))
(define drs-tabb (make-weak-box (send drs-frame1 get-current-tab)))
(define tab-nsb (make-weak-box (send (send (send drs-frame1 get-current-tab) get-ints) get-user-namespace)))
(test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Tab"))
(sync (system-idle-evt))
(test:menu-select "File" "New")
(sync (system-idle-evt))
(define drs-frame2b (make-weak-box (wait-for-new-frame drs-frame1)))
(define frame2-nsb (make-weak-box (send (send (send (weak-box-value drs-frame2b) get-current-tab) get-ints) get-user-namespace)))
(queue-callback/res
(λ () (send (send (send (weak-box-value drs-frame2b) get-current-tab) get-defs) load-file
(collection-file-path "unit.rkt" "drracket" "private"))))
(sleep 2)
(sync (system-idle-evt))
(test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Window"))
(sync (system-idle-evt))
(let loop ([n 30])
(cond
[(zero? n)
(when (weak-box-value drs-tabb)
(eprintf "frame leak!\n"))
(when (weak-box-value drs-frame2b)
(eprintf "tab leak!\n"))
(when (weak-box-value tab-nsb)
(eprintf "tab namespace leak!\n"))
(when (weak-box-value frame2-nsb)
(eprintf "frame namespace leak!\n"))]
[else
(collect-garbage) (sync (system-idle-evt))
(when (ormap weak-box-value
(list drs-tabb
tab-nsb
drs-frame2b
frame2-nsb))
(loop (- n 1)))])))))))
(define (try-to-find-leak online-compilation-string)
(define drs-frame1 (wait-for-drracket-frame))
(sync (system-idle-evt))
(for ([tries (in-range 3)])
(test:menu-select "File" "New Tab")
(sync (system-idle-evt))
(define drs-tabb (make-weak-box (send drs-frame1 get-current-tab)))
(define tab-nsb (make-weak-box (send (send (send drs-frame1 get-current-tab) get-ints) get-user-namespace)))
(test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Tab"))
(sync (system-idle-evt))
(test:menu-select "File" "New")
(sync (system-idle-evt))
(define drs-frame2b (make-weak-box (wait-for-new-frame drs-frame1)))
(define frame2-nsb (make-weak-box (send (send (send (weak-box-value drs-frame2b) get-current-tab) get-ints) get-user-namespace)))
(queue-callback/res
(λ () (send (send (send (weak-box-value drs-frame2b) get-current-tab) get-defs) load-file
(collection-file-path "unit.rkt" "drracket" "private"))))
(sleep 2)
(sync (system-idle-evt))
(test:menu-select "File" (if (eq? (system-type) 'unix) "Close" "Close Window"))
(sync (system-idle-evt))
(let loop ([n 30])
(cond
[(zero? n)
(when (weak-box-value drs-tabb)
(eprintf "~a frame leak!\n" online-compilation-string))
(when (weak-box-value drs-frame2b)
(eprintf "~a tab leak!\n" online-compilation-string))
(when (weak-box-value tab-nsb)
(eprintf "~a tab namespace leak!\n" online-compilation-string))
(when (weak-box-value frame2-nsb)
(eprintf "~a frame namespace leak!\n" online-compilation-string))]
[else
(collect-garbage) (sync (system-idle-evt))
(when (ormap weak-box-value
(list drs-tabb
tab-nsb
drs-frame2b
frame2-nsb))
(loop (- n 1)))]))))
(define (check-menus frame) (define (check-menus frame)
(define (process-container container) (define (process-container container)

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

@ -601,12 +601,16 @@
;; but just to print and return. ;; but just to print and return.
(define orig-display-handler (error-display-handler)) (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) (on-eventspace-handler-thread 'fire-up-drracket-and-run-tests)
(let () (let ()
(use-hash-for-prefs fw:preferences:low-level-get-preference (use-hash-for-prefs fw:preferences:low-level-get-preference
fw:preferences:low-level-put-preferences fw:preferences:low-level-put-preferences
fw:preferences:restore-defaults) fw:preferences:restore-defaults
prefs)
(parameterize ([current-command-line-arguments #()]) (parameterize ([current-command-line-arguments #()])
(dynamic-require 'drracket #f)) (dynamic-require 'drracket #f))
@ -654,7 +658,8 @@
(λ () (λ ()
(use-hash-for-prefs (dynamic-require 'framework 'preferences:low-level-get-preference) (use-hash-for-prefs (dynamic-require 'framework 'preferences:low-level-get-preference)
(dynamic-require 'framework 'preferences:low-level-put-preferences) (dynamic-require 'framework 'preferences:low-level-put-preferences)
(dynamic-require 'framework 'preferences:restore-defaults)) (dynamic-require 'framework 'preferences:restore-defaults)
'())
(dynamic-require 'drracket #f) (dynamic-require 'drracket #f)
(thread (λ () (thread (λ ()
(run-test) (run-test)
@ -664,23 +669,37 @@
(define (use-hash-for-prefs preferences:low-level-get-preference (define (use-hash-for-prefs preferences:low-level-get-preference
preferences:low-level-put-preferences preferences:low-level-put-preferences
preferences:restore-defaults) preferences:restore-defaults
prefs)
;; change the preferences system so that it doesn't write to ;; change the preferences system so that it doesn't write to
;; a file; partly to avoid problems of concurrency in drdr ;; a file; partly to avoid problems of concurrency in drdr
;; but also to make the test suite easier for everyone to run. ;; but also to make the test suite easier for everyone to run.
(let ([prefs-table (make-hash)]) (let ([prefs-table (make-hash)])
(preferences:low-level-put-preferences (preferences:low-level-put-preferences
(lambda (names vals) (λ (names vals)
(for-each (lambda (name val) (hash-set! prefs-table name val)) (for ([name (in-list names)]
names vals))) [val (in-list vals)])
(hash-set! prefs-table name val))))
(preferences:low-level-get-preference (preferences:low-level-get-preference
(lambda (name [fail (lambda () #f)]) (λ (name [fail (lambda () #f)])
(hash-ref prefs-table name fail))) (hash-ref prefs-table name fail)))
;; set all preferences to their defaults (some pref values may have ;; set all preferences to their defaults (some pref values may have
;; been read by this point, but hopefully that won't affect the ;; been read by this point, but hopefully that won't affect the
;; startup of drracket) ;; 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) (define (not-on-eventspace-handler-thread fn)
(when (eq? (current-thread) (eventspace-handler-thread (current-eventspace))) (when (eq? (current-thread) (eventspace-handler-thread (current-eventspace)))