From e6fc56a8b8298d9e615ca5ae71e49df1c213b2cd Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 13 Aug 2012 09:21:52 -0500 Subject: [PATCH] adjust the leak test so that it first runs with online compilation disabled and then runs with it enabled --- .../drracket/no-write-and-frame-leak.rkt | 102 ++++++++++-------- .../drracket/private/drracket-test-util.rkt | 37 +++++-- 2 files changed, 83 insertions(+), 56 deletions(-) diff --git a/collects/tests/drracket/no-write-and-frame-leak.rkt b/collects/tests/drracket/no-write-and-frame-leak.rkt index 5d437eb350..ce1ada43f1 100644 --- a/collects/tests/drracket/no-write-and-frame-leak.rkt +++ b/collects/tests/drracket/no-write-and-frame-leak.rkt @@ -29,57 +29,65 @@ This test checks: void void)]) (fire-up-drracket-and-run-tests + #:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f]) (λ () - (define drs-frame1 (wait-for-drracket-frame)) - (sync (system-idle-evt)) + (check-menus (wait-for-drracket-frame)) - (check-menus drs-frame1) + (try-to-find-leak "online compilation disabled:") - (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 "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)))]))))))) + (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)) + + (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 (process-container container) diff --git a/collects/tests/drracket/private/drracket-test-util.rkt b/collects/tests/drracket/private/drracket-test-util.rkt index f0558d6c3c..e1f69725ef 100644 --- a/collects/tests/drracket/private/drracket-test-util.rkt +++ b/collects/tests/drracket/private/drracket-test-util.rkt @@ -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)))