diff --git a/drracket-test/tests/drracket/private/drracket-test-util.rkt b/drracket-test/tests/drracket/private/drracket-test-util.rkt
index 507729b50..c52051b5d 100644
--- a/drracket-test/tests/drracket/private/drracket-test-util.rkt
+++ b/drracket-test/tests/drracket/private/drracket-test-util.rkt
@@ -11,9 +11,8 @@
"gui.rkt"
"no-fw-test-util.rkt")
- (provide/contract
- [use-get/put-dialog (-> (-> any) path? void?)]
- [set-module-language! (->* () (boolean?) void?)])
+ (provide (contract-out [use-get/put-dialog (-> (-> any) path? void?)]
+ [set-module-language! (->* () (boolean?) void?)]))
(provide queue-callback/res
fire-up-drracket-and-run-tests
@@ -60,25 +59,25 @@
;; filename is a string naming a file that should be typed into the dialog
(define (use-get/put-dialog open-dialog filename)
(not-on-eventspace-handler-thread 'use-get/put-dialog)
- (let ([drs (wait-for-drracket-frame)])
- (with-handlers ([(lambda (x) #t)
- (lambda (x)
- (fw:preferences:set 'framework:file-dialogs 'std)
- (raise x))])
- (fw:preferences:set 'framework:file-dialogs 'common)
- (open-dialog)
- (let ([dlg (wait-for-new-frame drs)])
- (send (find-labelled-window "Filename:" #f (fw:test:get-active-top-level-window)) focus)
- (fw:test:keystroke #\a (list (case (system-type)
- [(windows) 'control]
- [(macosx macos) 'meta]
- [(unix) 'control]
- [else (error 'use-get/put-dialog "unknown platform: ~s\n"
- (system-type))])))
- (for-each fw:test:keystroke (string->list (path->string filename)))
- (fw:test:button-push "OK")
- (wait-for-new-frame dlg))
- (fw:preferences:set 'framework:file-dialogs 'std))))
+ (define drs (wait-for-drracket-frame))
+ (with-handlers ([(lambda (x) #t) (lambda (x)
+ (fw:preferences:set 'framework:file-dialogs 'std)
+ (raise x))])
+ (fw:preferences:set 'framework:file-dialogs 'common)
+ (open-dialog)
+ (let ([dlg (wait-for-new-frame drs)])
+ (send (find-labelled-window "Filename:" #f (fw:test:get-active-top-level-window)) focus)
+ (fw:test:keystroke
+ #\a
+ (list (case (system-type)
+ [(windows) 'control]
+ [(macosx macos) 'meta]
+ [(unix) 'control]
+ [else (error 'use-get/put-dialog "unknown platform: ~s\n" (system-type))])))
+ (for-each fw:test:keystroke (string->list (path->string filename)))
+ (fw:test:button-push "OK")
+ (wait-for-new-frame dlg))
+ (fw:preferences:set 'framework:file-dialogs 'std)))
(define (test-util-error fmt . args)
(raise (make-exn (apply fmt args) (current-continuation-marks))))
@@ -90,10 +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))
- (if (and active
- (drracket-frame? active))
- active
- #f))
+ (and (and active (drracket-frame? active)) active))
(define drr-fr
(or (wait-for-drracket-frame-pred)
(begin
diff --git a/drracket-test/tests/drracket/private/easter-egg-lib.rkt b/drracket-test/tests/drracket/private/easter-egg-lib.rkt
index f22c39961..5fb151b01 100644
--- a/drracket-test/tests/drracket/private/easter-egg-lib.rkt
+++ b/drracket-test/tests/drracket/private/easter-egg-lib.rkt
@@ -64,7 +64,7 @@ and then loading the framework after that.
(define drr-frame (wait-for-drracket-frame))
(set-module-language! drr-frame)
(queue-callback/res
- (λ () (send (send (send drr-frame get-definitions-text) get-canvas) focus)))
+ (λ () (send+ drr-frame (get-definitions-text) (get-canvas) (focus))))
(for ([x (in-string "(car 'x)")])
(test:keystroke x))
(let ([button (queue-callback/res (λ () (send drr-frame get-execute-button)))])
@@ -81,10 +81,7 @@ and then loading the framework after that.
(define (wait-for-drracket-frame [print-message? #f])
(define (wait-for-drracket-frame-pred)
(define active (test:get-active-top-level-window))
- (if (and active
- (drracket-frame? active))
- active
- #f))
+ (and (and active (drracket-frame? active)) active))
(define drr-fr
(or (wait-for-drracket-frame-pred)
(begin
@@ -113,10 +110,9 @@ and then loading the framework after that.
(define (verify-drracket-frame-frontmost function-name frame)
(on-eventspace-handler-thread 'verify-drracket-frame-frontmost)
- (let ([tl (test:get-active-top-level-window)])
- (unless (and (eq? frame tl)
- (drracket-frame? tl))
- (error function-name "drracket frame not frontmost: ~e (found ~e)" frame tl))))
+ (define tl (test:get-active-top-level-window))
+ (unless (and (eq? frame tl) (drracket-frame? tl))
+ (error function-name "drracket frame not frontmost: ~e (found ~e)" frame tl)))
(define (set-module-language! drr-frame)
(test:menu-select "Language" "Choose Language…")
diff --git a/drracket-test/tests/drracket/private/gui.rkt b/drracket-test/tests/drracket/private/gui.rkt
index b4709ac1b..583036354 100644
--- a/drracket-test/tests/drracket/private/gui.rkt
+++ b/drracket-test/tests/drracket/private/gui.rkt
@@ -17,30 +17,17 @@
(cond
[(= i (string-length string1)) (only-whitespace? string2 j)]
[(= j (string-length string2)) (only-whitespace? string1 i)]
- [else (let ([c1 (string-ref string1 i)]
- [c2 (string-ref string2 j)])
- (cond
- [in-whitespace?
- (cond
- [(whitespace? c1)
- (loop (+ i 1)
- j
- #t)]
- [(whitespace? c2)
- (loop i
- (+ j 1)
- #t)]
- [else (loop i j #f)])]
- [(and (whitespace? c1)
- (whitespace? c2))
- (loop (+ i 1)
- (+ j 1)
- #t)]
- [(char=? c1 c2)
- (loop (+ i 1)
- (+ j 1)
- #f)]
- [else #f]))])))
+ [else (define c1 (string-ref string1 i))
+ (define c2 (string-ref string2 j))
+ (cond
+ [in-whitespace?
+ (cond
+ [(whitespace? c1) (loop (+ i 1) j #t)]
+ [(whitespace? c2) (loop i (+ j 1) #t)]
+ [else (loop i j #f)])]
+ [(and (whitespace? c1) (whitespace? c2)) (loop (+ i 1) (+ j 1) #t)]
+ [(char=? c1 c2) (loop (+ i 1) (+ j 1) #f)]
+ [else #f])])))
;; whitespace? : char -> boolean
;; deteremines if `c' is whitespace
diff --git a/drracket-test/tests/drracket/private/module-lang-test-utils.rkt b/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
index 3c68ea7fd..36e4c4810 100644
--- a/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
+++ b/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
@@ -99,32 +99,30 @@
(define output-start-paragraph 2)
(when ints
- (let ([after-execute-output
- (queue-callback/res
- (λ ()
- (send interactions-text
- get-text
- (send interactions-text paragraph-start-position 2)
- (send interactions-text paragraph-end-position 2))))])
- (unless (or (test-all? test) (string=? "> " after-execute-output))
- (eprintf (string-append
- "FAILED (line ~a): ~a\n"
- " ~a\n"
- " expected no output after execution, got: ~s\n")
- (test-line test)
- (test-definitions test)
- (or (test-interactions test) 'no-interactions)
- after-execute-output)
- (k (void)))
- (insert-in-interactions drs ints)
- ;; set to be the paragraph right after the insertion.
- (set! output-start-paragraph
- (queue-callback/res
- (λ () (+ (send interactions-text position-paragraph
- (send interactions-text last-position))
- 1))))
- (test:keystroke #\return '(alt))
- (wait-for-computation drs)))
+ (define after-execute-output
+ (queue-callback/res (λ ()
+ (send interactions-text
+ get-text
+ (send interactions-text paragraph-start-position 2)
+ (send interactions-text paragraph-end-position 2)))))
+ (unless (or (test-all? test) (string=? "> " after-execute-output))
+ (eprintf (string-append "FAILED (line ~a): ~a\n"
+ " ~a\n"
+ " expected no output after execution, got: ~s\n")
+ (test-line test)
+ (test-definitions test)
+ (or (test-interactions test) 'no-interactions)
+ after-execute-output)
+ (k (void)))
+ (insert-in-interactions drs ints)
+ ;; set to be the paragraph right after the insertion.
+ (set! output-start-paragraph
+ (queue-callback/res
+ (λ ()
+ (+ (send interactions-text position-paragraph (send interactions-text last-position))
+ 1))))
+ (test:keystroke #\return '(alt))
+ (wait-for-computation drs))
(define text
(queue-callback/res
@@ -148,13 +146,10 @@
(let loop ([snip (send interactions-text find-first-snip)])
(cond
[(not snip) '()]
- [else
- (cond
- [(method-in-interface? 'get-stacks (object-interface snip))
- (define-values (s1 s2) (send snip get-stacks))
- (list* s1 s2 (loop (send snip next)))]
- [else
- (loop (send snip next))])])))))
+ [(method-in-interface? 'get-stacks (object-interface snip))
+ (define-values (s1 s2) (send snip get-stacks))
+ (list* s1 s2 (loop (send snip next)))]
+ [else (loop (send snip next))])))))
(define output-passed?
(let ([r (test-result test)])
((cond [(string? r) string=?]
@@ -170,23 +165,23 @@
text)
(unless (null? stacks)
(eprintf "stacks from error message:\n")
- (for ([stack (in-list stacks)])
- (when stack
- (eprintf "\n----\n")
- (unless (empty-viewable-stack? stack)
- (define stack-iterator (copy-viewable-stack stack))
- (let loop ()
- (define-values (list-of-srcloc-count has-next?)
- (viewable-stack-get-next-items! stack-iterator))
- (for ([srcloc-count (in-list list-of-srcloc-count)])
- (define frame (srcloc->string (car srcloc-count)))
- (define count (+ 1 (cdr srcloc-count)))
- (if (> count 1)
- (eprintf " ~a [repeated ~a times]\n" frame count)
- (eprintf " ~a\n" frame)))
- (when has-next?
- (loop))))
- (eprintf "----\n")))))
+ (for ([stack (in-list stacks)]
+ #:when stack)
+ (eprintf "\n----\n")
+ (unless (empty-viewable-stack? stack)
+ (define stack-iterator (copy-viewable-stack stack))
+ (let loop ()
+ (define-values (list-of-srcloc-count has-next?)
+ (viewable-stack-get-next-items! stack-iterator))
+ (for ([srcloc-count (in-list list-of-srcloc-count)])
+ (define frame (srcloc->string (car srcloc-count)))
+ (define count (+ 1 (cdr srcloc-count)))
+ (if (> count 1)
+ (eprintf " ~a [repeated ~a times]\n" frame count)
+ (eprintf " ~a\n" frame)))
+ (when has-next?
+ (loop))))
+ (eprintf "----\n"))))
(define the-assert (test-extra-assert test))
(define-values (kws-req kws-acc) (procedure-keywords the-assert))
(define-values (kws kw-vals)
@@ -225,9 +220,9 @@
(for-each single-test (reverse tests))
(clear-definitions drs)
(queue-callback/res (λ () (send (send drs get-definitions-text) set-modified #f)))
- (for ([file temp-files])
- (when (file-exists? file)
- (delete-file file))))
+ (for ([file temp-files]
+ #:when (file-exists? file))
+ (delete-file file)))
(define (run-use-compiled-file-paths-tests)
(define (setup-dialog/run proc)
diff --git a/drracket-test/tests/drracket/private/no-fw-test-util.rkt b/drracket-test/tests/drracket/private/no-fw-test-util.rkt
index a47a10584..79e7a3a15 100644
--- a/drracket-test/tests/drracket/private/no-fw-test-util.rkt
+++ b/drracket-test/tests/drracket/private/no-fw-test-util.rkt
@@ -66,52 +66,52 @@
;; 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
'queue-callback/res
#:more (λ () (format "\n thunk: ~e" thunk)))
- (let ([c (make-channel)])
- (queue-callback (λ () (channel-put c (with-handlers ((exn:fail? values))
- (call-with-values thunk list))))
- #f)
- (define res (channel-get c))
- (when (exn? res) (raise res))
- (apply values res)))
+ (define c (make-channel))
+ (queue-callback (λ ()
+ (channel-put c
+ (with-handlers ([exn:fail? values])
+ (call-with-values thunk list))))
+ #f)
+ (define res (channel-get c))
+ (when (exn? res)
+ (raise res))
+ (apply values res))
;; poll-until : (-> alpha) number (-> alpha) -> alpha
;; waits until pred return a true value and returns that.
@@ -122,15 +122,15 @@
(error 'poll-until
"timeout after ~e secs, ~e never returned a true value"
secs pred))])
- (let ([step 1/20])
- (let loop ([counter secs])
- (if (<= counter 0)
- (fail)
- (let ([result (pred)])
- (or result
- (begin
- (sleep step)
- (loop (- counter step)))))))))
+ (define step 1/20)
+ (let loop ([counter secs])
+ (if (<= counter 0)
+ (fail)
+ (let ([result (pred)])
+ (or result
+ (begin
+ (sleep step)
+ (loop (- counter step))))))))
(define (wait-for-events-in-frame-eventspace fr)
(define sema (make-semaphore 0))
diff --git a/drracket-test/tests/drracket/private/repl-test.rkt b/drracket-test/tests/drracket/private/repl-test.rkt
index 1f3ec2624..9d7d92783 100644
--- a/drracket-test/tests/drracket/private/repl-test.rkt
+++ b/drracket-test/tests/drracket/private/repl-test.rkt
@@ -18,7 +18,7 @@ This produces an ACK message
mred
framework)
-(provide/contract [run-test (-> (listof (or/c 'raw 'debug 'debug/profile 'misc)) any)])
+(provide (contract-out [run-test (-> (listof (or/c 'raw 'debug 'debug/profile 'misc)) any)]))
(define-struct loc (line col offset))
;; loc = (make-loc number number number)
@@ -1010,7 +1010,7 @@ This produces an ACK message
(define backtrace-image-string "{stop-multi.png}")
(define file-image-string "{stop-22x22.png}")
-(define tmp-load-directory (make-temporary-file "repltest~a" 'directory))
+(define tmp-load-directory (make-temporary-directory "repltest~a"))
(define tmp-load-short-filename "repl-test-tmp.rkt")
(define tmp-load-filename (build-path tmp-load-directory tmp-load-short-filename))
@@ -1047,15 +1047,15 @@ This produces an ACK message
(define snip
(queue-callback/res
(lambda ()
- (let* ([start (send ints-text paragraph-start-position 2)]
- ;; since the fraction is supposed to be one char wide, we just
- ;; select one char, so that, if the regular number prints out,
- ;; this test will fail.
- [end (+ start 1)])
- (send ints-text split-snip start)
- (send ints-text split-snip end)
- (define snip (send ints-text find-snip start 'after))
- (and snip (send snip copy))))))
+ (define start (send ints-text paragraph-start-position 2))
+ ;; since the fraction is supposed to be one char wide, we just
+ ;; select one char, so that, if the regular number prints out,
+ ;; this test will fail.
+ (define end (+ start 1))
+ (send ints-text split-snip start)
+ (send ints-text split-snip end)
+ (define snip (send ints-text find-snip start 'after))
+ (and snip (send snip copy)))))
(clear-definitions drr-frame)
(type-in-definitions drr-frame "(+ ")
(queue-callback/res
@@ -1318,16 +1318,16 @@ This produces an ACK message
(wait-for-drr-frame-computation)
(for-each test:keystroke (string->list "x"))
- (let ([start (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
- (test:keystroke #\return)
- (wait-for-drr-frame-computation)
-
- (let* ([end (- (get-int-pos) 1)]
- [output (fetch-output drr-frame start end)]
- [expected #rx"x:.*cannot reference an identifier before its definition"])
- (unless (regexp-match expected output)
- (failure)
- (eprintf "callcc-test: expected something matching ~s, got ~s\n" expected output)))))
+ (define start (+ 1 (queue-callback/res (λ () (send ints-text last-position)))))
+ (test:keystroke #\return)
+ (wait-for-drr-frame-computation)
+
+ (define end (- (get-int-pos) 1))
+ (define output (fetch-output drr-frame start end))
+ (define expected #rx"x:.*cannot reference an identifier before its definition")
+ (unless (regexp-match expected output)
+ (failure)
+ (eprintf "callcc-test: expected something matching ~s, got ~s\n" expected output)))
(define (random-seed-test)
(define expression
@@ -1338,57 +1338,55 @@ This produces an ACK message
(wait-for-drr-frame-computation)
(insert-in-interactions drr-frame expression)
- (let ([start1 (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
- (test:keystroke #\return)
- (wait-for-drr-frame-computation)
- (let ([output1 (fetch-output drr-frame start1 (- (get-int-pos) 1))])
- (insert-in-interactions drr-frame expression)
- (let ([start2 (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
- (test:keystroke #\return)
- (wait-for-drr-frame-computation)
- (let ([output2 (fetch-output drr-frame start2 (- (get-int-pos) 1))])
- (unless (equal? output1 output2)
- (failure)
- (eprintf "random-seed-test: expected\n ~s\nand\n ~s\nto be the same"
- output1
- output2)))))))
+ (define start1 (+ 1 (queue-callback/res (λ () (send ints-text last-position)))))
+ (test:keystroke #\return)
+ (wait-for-drr-frame-computation)
+ (define output1 (fetch-output drr-frame start1 (- (get-int-pos) 1)))
+ (insert-in-interactions drr-frame expression)
+ (define start2 (+ 1 (queue-callback/res (λ () (send ints-text last-position)))))
+ (test:keystroke #\return)
+ (wait-for-drr-frame-computation)
+ (define output2 (fetch-output drr-frame start2 (- (get-int-pos) 1)))
+ (unless (equal? output1 output2)
+ (failure)
+ (eprintf "random-seed-test: expected\n ~s\nand\n ~s\nto be the same" output1 output2)))
(define (top-interaction-test)
(clear-definitions drr-frame)
(do-execute drr-frame)
(wait-for-drr-frame-computation)
- (let ([ints-just-after-welcome (queue-callback/res (λ () (+ 1 (send ints-text last-position))))])
-
- (type-in-definitions
- drr-frame
- "(define-syntax #%top-interaction (syntax-rules () [(_ . e) 'e]))\n(+ 1 2)\n")
- (test:menu-select "File" "Save Definitions")
-
- (clear-definitions drr-frame)
- (do-execute drr-frame)
+ (queue-callback/res (λ () (+ 1 (send ints-text last-position))))
+
+ (type-in-definitions
+ drr-frame
+ "(define-syntax #%top-interaction (syntax-rules () [(_ . e) 'e]))\n(+ 1 2)\n")
+ (test:menu-select "File" "Save Definitions")
+
+ (clear-definitions drr-frame)
+ (do-execute drr-frame)
+ (wait-for-drr-frame-computation)
+
+ (for-each test:keystroke (string->list (format "(load ~s)" tmp-load-short-filename)))
+ (let ([start (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
+ (test:keystroke #\return)
(wait-for-drr-frame-computation)
-
- (for-each test:keystroke (string->list (format "(load ~s)" tmp-load-short-filename)))
- (let ([start (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
- (test:keystroke #\return)
- (wait-for-drr-frame-computation)
- (let* ([end (- (get-int-pos) 1)]
- [output (fetch-output drr-frame start end)]
- [expected "(+ 1 2)"])
- (unless (equal? output expected)
- (error 'top-interaction-test "expected.1 ~s, got ~s" expected output))
- (next-test)))
-
- (for-each test:keystroke (string->list "(+ 4 5)"))
- (let ([start (+ 1 (queue-callback/res (λ () (send ints-text last-position))))])
- (test:keystroke #\return)
- (wait-for-drr-frame-computation)
- (let* ([end (- (get-int-pos) 1)]
- [output (fetch-output drr-frame start end)]
- [expected "(+ 4 5)"])
- (unless (equal? output expected)
- (error 'top-interaction-test "expected.2 ~s, got ~s" expected output))
- (next-test)))))
+ (let* ([end (- (get-int-pos) 1)]
+ [output (fetch-output drr-frame start end)]
+ [expected "(+ 1 2)"])
+ (unless (equal? output expected)
+ (error 'top-interaction-test "expected.1 ~s, got ~s" expected output))
+ (next-test)))
+
+ (for-each test:keystroke (string->list "(+ 4 5)"))
+ (define start (+ 1 (queue-callback/res (λ () (send ints-text last-position)))))
+ (test:keystroke #\return)
+ (wait-for-drr-frame-computation)
+ (define end (- (get-int-pos) 1))
+ (define output (fetch-output drr-frame start end))
+ (define expected "(+ 4 5)")
+ (unless (equal? output expected)
+ (error 'top-interaction-test "expected.2 ~s, got ~s" expected output))
+ (next-test))
(when (file-exists? tmp-load-filename)
(delete-file tmp-load-filename))