Automated Resyntax fixes

drracket-test/tests/drracket/memory-log.rkt

@@ -18,57 +18,47 @@
   (let loop ([cmu (current-memory-use)]
              [n 20])
     (collect-garbage)
-    (let ([new-cmu (current-memory-use)])
-      (cond
-        [(or (< n 0)
-             (< (abs (- cmu new-cmu)) 
-                (* 0.01 cmu)))
-         new-cmu]
-        [else
-         (loop new-cmu (- n 1))]))))
+    (define new-cmu (current-memory-use))
+    (cond
+      [(or (< n 0) (< (abs (- cmu new-cmu)) (* 0.01 cmu))) new-cmu]
+      [else (loop new-cmu (- n 1))])))
 
 (void (putenv "PLTDRPLACEPRINT" "yes"))
 
 (define (wait-and-print)
-  (let ([s (make-semaphore 0)])
-    ;; let two rounds of pending events be handled. 
-    (queue-callback (λ () (queue-callback  (λ () (semaphore-post s)) #f)) #f)
-    (yield s)
-
-    ;; print out memory use in a fake form to be tracked by drdr
-    (let ([n (mem-cnt)])
-      (printf "cpu time: ~a real time: ~a gc time: ~a\n"
-              n n n))))
+  (define s (make-semaphore 0))
+  ;; let two rounds of pending events be handled.
+  (queue-callback (λ () (queue-callback (λ () (semaphore-post s)) #f)) #f)
+  (yield s)
+
+  ;; print out memory use in a fake form to be tracked by drdr
+  (define n (mem-cnt))
+  (printf "cpu time: ~a real time: ~a gc time: ~a\n" n n n))
 
 (fire-up-drracket-and-run-tests 
  (λ ()
-   (let ([drs-frame (wait-for-drracket-frame)])
-
-     ;; initial startup memory use
-     (wait-and-print)
-
-     ;; figure out the memory use after running check syntax once (and so the docs 
-     ;; have been loaded)
-     (queue-callback
-      (λ () (send (send drs-frame get-definitions-text) insert "#lang racket/base\n+")))
-     (set-module-language!)
-     (test:run-one (lambda () (send (send drs-frame syncheck:get-button) command)))
-     (wait-for-computation drs-frame)
-     (wait-and-print)
-
-     ;; figure out the memory use after letting online check syntax run once
-     ;; (so a place has been created and the docs loaded again (in the other place
-     ;; this time))
-
-     ; clear out the check synax results from before
-     (queue-callback/res (λ () (send (send drs-frame get-definitions-text) insert "\n")))
-     (poll-until
-      (λ ()
-        (not (send (send drs-frame get-definitions-text) syncheck:arrows-visible?))))
-
-     ; enable online check syntax and wait for the results to appear
-     (queue-callback/res (λ () (preferences:set 'drracket:online-compilation-default-on #t)))
-     (poll-until
-      (λ ()
-        (send (send drs-frame get-definitions-text) syncheck:arrows-visible?)))
-     (wait-and-print))))
+   (define drs-frame (wait-for-drracket-frame))
+
+   ;; initial startup memory use
+   (wait-and-print)
+
+   ;; figure out the memory use after running check syntax once (and so the docs
+   ;; have been loaded)
+   (queue-callback (λ () (send (send drs-frame get-definitions-text) insert "#lang racket/base\n+")))
+   (set-module-language!)
+   (test:run-one (lambda () (send (send drs-frame syncheck:get-button) command)))
+   (wait-for-computation drs-frame)
+   (wait-and-print)
+
+   ;; figure out the memory use after letting online check syntax run once
+   ;; (so a place has been created and the docs loaded again (in the other place
+   ;; this time))
+
+   ; clear out the check synax results from before
+   (queue-callback/res (λ () (send (send drs-frame get-definitions-text) insert "\n")))
+   (poll-until (λ () (not (send (send drs-frame get-definitions-text) syncheck:arrows-visible?))))
+
+   ; enable online check syntax and wait for the results to appear
+   (queue-callback/res (λ () (preferences:set 'drracket:online-compilation-default-on #t)))
+   (poll-until (λ () (send (send drs-frame get-definitions-text) syncheck:arrows-visible?)))
+   (wait-and-print)))

drracket-test/tests/drracket/online-compilation-zo-creation.rkt

@@ -33,7 +33,7 @@
 
 (fire-up-drracket-and-run-tests
  (λ ()
-   (define tmp-dir (make-temporary-file "online-compilation-zo-creation~a" 'directory))
+   (define tmp-dir (make-temporary-directory "online-compilation-zo-creation~a"))
 
    ;; 1. setup the files used in the test
 

drracket-test/tests/drracket/snips.rkt

@@ -10,7 +10,7 @@
  (λ ()
 
    (define drs (wait-for-drracket-frame))
-   (define tmpdir (make-temporary-file "drracketsniptest~a" 'directory))
+   (define tmpdir (make-temporary-directory "drracketsniptest~a"))
    (define defs (queue-callback/res (λ () (send drs get-definitions-text))))
    (for ([rfile (in-list (directory-list snip))])
      (define file (build-path snip rfile))

drracket-test/tests/drracket/syncheck-eval-compile-time.rkt

@@ -7,15 +7,14 @@
 (define (main)
   (fire-up-drracket-and-run-tests
    (λ ()
-     (let ([drs (wait-for-drracket-frame)])
-       (set-module-language!)
-       (do-execute drs)
-       (queue-callback/res
-        (λ () 
-          (preferences:set 'framework:coloring-active #f)
-          (handler:edit-file (collection-file-path "map.rkt" "racket" "private"))))
-
-       (click-check-syntax-and-check-errors drs "syncheck-eval-compile-time.rkt")))))
+     (define drs (wait-for-drracket-frame))
+     (set-module-language!)
+     (do-execute drs)
+     (queue-callback/res (λ ()
+                           (preferences:set 'framework:coloring-active #f)
+                           (handler:edit-file (collection-file-path "map.rkt" "racket" "private"))))
+
+     (click-check-syntax-and-check-errors drs "syncheck-eval-compile-time.rkt"))))
 
 
 ;; copied from syncheck-test.rkt ....
@@ -25,11 +24,9 @@
   (when (queue-callback/res (λ () (send (send drs get-definitions-text) in-edit-sequence?)))
     (error 'syncheck-test.rkt "still in edit sequence for ~s" test))
 
-  (let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))]) 
-    (when err
-      (eprintf "FAILED ~s\n   error report window is visible:\n   ~a\n"
-               test
-               err))))
+  (define err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents))))
+  (when err
+    (eprintf "FAILED ~s\n   error report window is visible:\n   ~a\n" test err)))
 (define (click-check-syntax-button drs)
   (test:run-one (lambda () (send (send drs syncheck:get-button) command))))
 

drracket-test/tests/drracket/syncheck-test.rkt

@@ -37,11 +37,16 @@
   (define-struct prefix-test (line input pos prefix output) #:transparent)
   (define-struct err-test (line input expected locations) #:transparent)
 
-  (define build-test/proc
-    (λ (line input expected [arrow-table '()] #:tooltips [tooltips #f] 
-             #:setup [setup void] #:teardown [teardown void] #:extra-files [extra-files (hash)]
-             #:extra-info? [extra-info? #f])
-      (make-test line input expected arrow-table tooltips setup teardown extra-files extra-info?)))
+  (define (build-test/proc line
+                           input
+                           expected
+                           [arrow-table '()]
+                           #:tooltips [tooltips #f]
+                           #:setup [setup void]
+                           #:teardown [teardown void]
+                           #:extra-files [extra-files (hash)]
+                           #:extra-info? [extra-info? #f])
+    (make-test line input expected arrow-table tooltips setup teardown extra-files extra-info?))
 
   (define-syntax (build-test stx)
     (syntax-case stx ()
@@ -1754,7 +1759,7 @@
 
 
   (define (main)
-    (define temp-dir (normalize-path (make-temporary-file "syncheck-test~a" 'directory)))
+    (define temp-dir (normalize-path (make-temporary-directory "syncheck-test~a")))
     (dynamic-wind
      void
      (λ ()

drracket-test/tests/drracket/time-keystrokes.rkt

@@ -42,10 +42,10 @@
           (let loop ([n 10])
             (when (zero? n)
               (error 'time-keystrokes "could not find drracket frame"))
-            (let ([front-frame (test:get-active-top-level-window)])
-              (unless (eq? front-frame frame)
-                (sleep 1/10)
-                (loop (- n 1)))))
+            (define front-frame (test:get-active-top-level-window))
+            (unless (eq? front-frame frame)
+              (sleep 1/10)
+              (loop (- n 1))))
           (let ([win (send frame get-definitions-canvas)])
             (send win focus)
             (time (send-key-events win chars-to-test)))

drracket-tool-lib/drracket/private/standalone-module-browser.rkt

@@ -412,13 +412,13 @@
               ;; note: the preference drracket:module-browser:name-length is also used for
               ;; the View|Show Module Browser version of the module browser
               ;; here we just treat any pref value except '3' as if it were for the long names.
-              (let ([selection (send module-browser-name-length-choice get-selection)])
-                (preferences:set 'drracket:module-browser:name-length (+ 2 selection))
-                (send pasteboard
-                      set-name-length
-                      (case selection
-                        [(0) 'long]
-                        [(1) 'very-long])))))))
+              (define selection (send module-browser-name-length-choice get-selection))
+              (preferences:set 'drracket:module-browser:name-length (+ 2 selection))
+              (send pasteboard
+                    set-name-length
+                    (case selection
+                      [(0) 'long]
+                      [(1) 'very-long]))))))
     (send pkg-choice set-string-selection (send pasteboard get-main-file-pkg))
 
     (define ec (make-object overview-editor-canvas% vp pasteboard))
@@ -461,17 +461,18 @@
 
     (set! update-label
           (λ (s)
-            (if (and s (not (null? s)))
-                (let* ([currently-over (car s)]
-                       [fn (send currently-over get-filename)]
-                       [lines (send currently-over get-lines)])
-                  (when (and fn lines)
-                    (define label (format filename-constant fn lines))
-                    (define pkg (send currently-over get-pkg))
-                    (when pkg
-                      (set! label (string-append (format pkg-constant pkg) "  " label)))
-                    (send label-message set-label label)))
-                (send label-message set-label ""))))
+            (cond
+              [(and s (not (null? s)))
+               (define currently-over (car s))
+               (define fn (send currently-over get-filename))
+               (define lines (send currently-over get-lines))
+               (when (and fn lines)
+                 (define label (format filename-constant fn lines))
+                 (define pkg (send currently-over get-pkg))
+                 (when pkg
+                   (set! label (string-append (format pkg-constant pkg) "  " label)))
+                 (send label-message set-label label))]
+              [else (send label-message set-label "")])))
 
     (send pasteboard
           set-name-length
@@ -937,7 +938,7 @@
           (call-with-input-file filename
                                 (λ (port)
                                   (let loop ([n 0])
-                                    (define l (read-line port))
+                                    (define l (read-line port 'any))
                                     (if (eof-object? l)
                                         n
                                         (loop (+ n 1)))))
@@ -1059,24 +1060,25 @@
                (let loop ([snips this-level-snips]
                           [minor-dim (/ (- max-minor this-minor) 2)])
                  (unless (null? snips)
-                   (let* ([snip (car snips)]
-                          [new-major-coord (+ major-dim
-                                              (floor (- (/ this-major 2)
-                                                        (/ (if vertical?
-                                                               (get-snip-height snip)
-                                                               (get-snip-width snip))
-                                                           2))))])
-                     (if vertical?
-                         (move-to snip minor-dim new-major-coord)
-                         (move-to snip new-major-coord minor-dim))
-                     (loop (cdr snips)
-                           (+ minor-dim
-                              (if vertical?
-                                  (get-snip-hspace)
-                                  (get-snip-vspace))
-                              (if vertical?
-                                  (get-snip-width snip)
-                                  (get-snip-height snip)))))))
+                   (define snip (car snips))
+                   (define new-major-coord
+                     (+ major-dim
+                        (floor (- (/ this-major 2)
+                                  (/ (if vertical?
+                                         (get-snip-height snip)
+                                         (get-snip-width snip))
+                                     2)))))
+                   (if vertical?
+                       (move-to snip minor-dim new-major-coord)
+                       (move-to snip new-major-coord minor-dim))
+                   (loop (cdr snips)
+                         (+ minor-dim
+                            (if vertical?
+                                (get-snip-hspace)
+                                (get-snip-vspace))
+                            (if vertical?
+                                (get-snip-width snip)
+                                (get-snip-height snip))))))
                (loop (cdr levels)
                      (+ major-dim
                         (if vertical?
@@ -1119,8 +1121,8 @@
                    (let loop ([snip (find-first-snip)])
                      (when snip
                        (when (is-a? snip boxed-word-snip<%>)
-                         (let ([filename (send snip get-filename)])
-                           (on-boxed-word-double-click filename)))
+                         (define filename (send snip get-filename))
+                         (on-boxed-word-double-click filename))
                        (loop (send snip next)))))])
            (send canvas popup-menu right-button-menu (+ (send evt get-x) 1) (+ (send evt get-y) 1))]
           [else (super on-event evt)]))
@@ -1256,19 +1258,20 @@
                    ""
                    (string (string-ref word 0)))]
               [(medium)
-               (let ([m (regexp-match #rx"^(.*)\\.[^.]*$" word)])
-                 (let ([short-name (if m
-                                       (cadr m)
-                                       word)])
-                   (if (string=? short-name "")
-                       ""
-                       (let ([ms (regexp-match* #rx"-[^-]*" short-name)])
-                         (cond
-                           [(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
-                           [else
-                            (apply string-append
-                                   (cons (substring short-name 0 1)
-                                         (map (λ (x) (substring x 1 2)) ms)))])))))]
+               (define m (regexp-match #rx"^(.*)\\.[^.]*$" word))
+               (define short-name
+                 (if m
+                     (cadr m)
+                     word))
+               (if (string=? short-name "")
+                   ""
+                   (let ([ms (regexp-match* #rx"-[^-]*" short-name)])
+                     (cond
+                       [(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
+                       [else
+                        (apply string-append
+                               (cons (substring short-name 0 1)
+                                     (map (λ (x) (substring x 1 2)) ms)))])))]
               [(long) word]
               [(very-long) (string-append word ": " (format "~s" require-phases))]))
            last-name]))
@@ -1345,16 +1348,16 @@
          (λ ()
            (moddep-current-open-input-file
             (λ (filename)
-              (let* ([p (open-input-file filename)]
-                     [wxme? (regexp-match-peek #rx#"^WXME" p)])
-                (if wxme?
-                    (let ([t (new text%)])
-                      (close-input-port p)
-                      (send t load-file filename)
-                      (let ([prt (open-input-text-editor t)])
-                        (port-count-lines! prt)
-                        prt))
-                    p))))
+              (define p (open-input-file filename))
+              (define wxme? (regexp-match-peek #rx#"^WXME" p))
+              (if wxme?
+                  (let ([t (new text%)])
+                    (close-input-port p)
+                    (send t load-file filename)
+                    (let ([prt (open-input-text-editor t)])
+                      (port-count-lines! prt)
+                      prt))
+                  p)))
            (current-load-relative-directory #f)
            (define relative? (eq? init-dir 'relative))
            (unless relative? ; already there

drracket/drracket/private/syncheck/gui.rkt

@@ -2259,7 +2259,7 @@ If the namespace does not, they are colored the unbound color.
                ;; if we've been asked to stop (because some new results are ready
                ;; and another trace is running).
                (void)]
-              [(and (i . > . 0)  ;; check i just in case things are really strange
+              [(and (positive? i)  ;; check i just in case things are really strange
                     (20 . <= . (- (current-inexact-milliseconds) start-time)))
                (queue-callback
                 (λ ()

drracket/drracket/private/syncheck/online-comp.rkt

@@ -67,9 +67,9 @@
       (make-traversal (current-namespace)
                       (get-init-dir path)))
     (parameterize ([current-annotations obj])
-      (for ([stx (in-list stxes)])
-        (when (equal? (syntax-source stx) the-source)
-          (expanded-expression stx)))
+      (for ([stx (in-list stxes)]
+            #:when (equal? (syntax-source stx) the-source))
+        (expanded-expression stx))
       (expansion-completed))
     (send obj get-trace)))