Skip to content
4 changes: 2 additions & 2 deletions drracket-test/tests/drracket/private/drracket-test-util.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@
(define (wait-for-drracket-frame [print-message? #f])
(define (wait-for-drracket-frame-pred)
(define active (fw:test:get-active-top-level-window))
(and (and active (drracket-frame? active)) active))
(and active (drracket-frame? active) active))
(define drr-fr
(or (wait-for-drracket-frame-pred)
(begin
Expand All @@ -112,7 +112,7 @@
(for/or ([eventspace (in-list extra-eventspaces)])
(parameterize ([current-eventspace eventspace])
(fw:test:get-active-top-level-window)))))
(and (and active (not (eq? active old-frame))) active))
(and active (not (eq? active old-frame)) active))
(define lab (send old-frame get-label))
(define fr (poll-until
(procedure-rename wait-for-new-frame-pred
Expand Down
69 changes: 33 additions & 36 deletions drracket-test/tests/drracket/private/no-fw-test-util.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -57,49 +57,46 @@
(yield (make-semaphore 0)))))))
(semaphore-wait s))

(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:restore-defaults
preferences:set
preferences:default-set?
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
;; but also to make the test suite easier for everyone to run.
(let ([prefs-table (make-hash)])
(preferences:low-level-put-preferences
(λ (names vals)
(for ([name (in-list names)]
[val (in-list vals)])
(hash-set! prefs-table name val))))
(preferences:low-level-get-preference
(λ (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)

;; 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))
(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 prefs-table (make-hash))
(preferences:low-level-put-preferences (λ (names vals)
(for ([name (in-list names)]
[val (in-list vals)])
(hash-set! prefs-table name val))))
(preferences:low-level-get-preference (λ (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)

;; 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))
(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 (queue-callback/res thunk)
(not-on-eventspace-handler-thread
Expand Down
Loading