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

fix no-write-and-frame-leak.rkt test case

Browse Source 
more precisely, fix the way that the drracket test utilities
deal with the test suite so that when certain prefs are
initialized (as part of a test suite startup of drracket),
they actually get initialized properly (this was broken for
preferences whose value gets read particularly early)

Then use that to disable autosaving in the no-write-and-frame-leak.rkt
test
This commit is contained in:
Robby Findler 2013-11-09 00:18:39 -06:00
parent 3cfe5c0c57
commit 2a28049c05
2 changed files with 36 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/drracket-pkgs/drracket-test/tests/drracket/no-write-and-frame-leak.rkt
View File

@ -40,7 +40,8 @@ This test checks:
void
void)])
(fire-up-drracket-and-run-tests
#:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f])
#:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f]
[plt:framework-pref:framework:autosaving-on? #f])
(λ ()
(define drr (wait-for-drracket-frame))
(check-reorder-tabs drr)
@ -69,7 +70,8 @@ This test checks:
(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)))
(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))
@ -78,7 +80,9 @@ This test checks:
(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)))
(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

44
pkgs/drracket-pkgs/drracket-test/tests/drracket/private/drracket-test-util.rkt
View File

@ -642,6 +642,8 @@
(use-hash-for-prefs fw:preferences:low-level-get-preference
fw:preferences:low-level-put-preferences
fw:preferences:restore-defaults
fw:preferences:set
fw:preferences:default-set?
prefs)
(parameterize ([current-command-line-arguments #()])
@ -650,15 +652,15 @@
(fw:test:use-focus-table use-focus-table?)
(thread (λ ()
(let ([orig-display-handler (error-display-handler)])
(uncaught-exception-handler
(λ (x)
(if (exn? x)
(orig-display-handler (exn-message x) x)
(eprintf "uncaught exception ~s\n" x))
(exit 1))))
(run-test)
(exit)))
(let ([orig-display-handler (error-display-handler)])
(uncaught-exception-handler
(λ (x)
(if (exn? x)
(orig-display-handler (exn-message x) x)
(eprintf "uncaught exception ~s\n" x))
(exit 1))))
(run-test)
(exit)))
(yield (make-semaphore 0))))
;; fire-up-separate-drracket-and-run-tests : (-> any) -> any
@ -691,6 +693,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:set)
(dynamic-require 'framework 'preferences:default-set?)
'())
(dynamic-require 'drracket #f)
(thread (λ ()
@ -702,6 +706,8 @@
(define (use-hash-for-prefs preferences:low-level-get-preference
preferences:low-level-put-preferences
preferences:restore-defaults
preferences:set
preferences:default-set?
prefs)
;; change the preferences system so that it doesn't write to
;; a file; partly to avoid problems of concurrency in drdr
@ -723,15 +729,23 @@
;; initialize some preferences to simulate these
;; being saved already in the user's prefs file
;; call preferences:set too since the prefs file
;; may have been "read" already at this point
(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 m (regexp-match #rx"^plt:framework-pref:(.*)$" (symbol->string pref-key)))
(cond
[m
(hash-set! prefs-table pref-key pref-val)
(define fw-pref-key (string->symbol (list-ref m 1)))
(when (preferences:default-set? fw-pref-key)
(preferences:set fw-pref-key pref-val))]
[else
;; 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)]))))
(define (not-on-eventspace-handler-thread fn)
(when (eq? (current-thread) (eventspace-handler-thread (current-eventspace)))