Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #714

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
48 changes: 22 additions & 26 deletions drracket-test/tests/drracket/private/drracket-test-util.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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?)]))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems like another situation where we are missing some newlines.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.


(provide queue-callback/res
fire-up-drracket-and-run-tests
Expand Down Expand Up @@ -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)])
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

How come this let didn't go away?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We have been asking this a lot. I think one thing that would help is for the PR description to indicate if there's any limitation reached. If so, we wouldn't need to ask anymore if it's Resyntax's fault or not when some issues are not fixed.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That sounds like a great idea.

(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))))
Expand All @@ -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))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

we only need one and here, but maybe that's out of the scope of this improvement?

(define drr-fr
(or (wait-for-drracket-frame-pred)
(begin
Expand Down
14 changes: 5 additions & 9 deletions drracket-test/tests/drracket/private/easter-egg-lib.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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))))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think this one is a good change, actually. It isn't like the example in the documentation for send+ where we're getting objects of the same type back and doing functional update.

(for ([x (in-string "(car 'x)")])
(test:keystroke x))
(let ([button (queue-callback/res (λ () (send drr-frame get-execute-button)))])
Expand All @@ -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))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ditto (copied code, I wonder?!)

(define drr-fr
(or (wait-for-drracket-frame-pred)
(begin
Expand Down Expand Up @@ -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…")
Expand Down
35 changes: 11 additions & 24 deletions drracket-test/tests/drracket/private/gui.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
101 changes: 48 additions & 53 deletions drracket-test/tests/drracket/private/module-lang-test-utils.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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))])))))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This one is not a good change. This is going against the data definition. That is, the outer cond is part of the processing of snip (there are two cases for the input and, in the second case of the input, I want to do a conditional thing).

(define output-passed?
(let ([r (test-result test)])
((cond [(string? r) string=?]
Expand All @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
100 changes: 50 additions & 50 deletions drracket-test/tests/drracket/private/no-fw-test-util.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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))
Expand Down
Loading
Loading