explicit flush after output intended to report progress

pkgs/distro-build/drive-clients.rkt

@@ -91,6 +91,7 @@
   (displayln (apply ~a #:separator " " 
                     (map (lambda (p) (if (path? p) (path->string p) p)) 
                          (cons exe args))))
+  (flush-output)
   (apply system* exe args))
 
 (define (system*/string . args)
@@ -153,6 +154,7 @@
              (client-name c))))
   (when vbox
     (printf "Starting VirtualBox machine ~s\n" vbox)
+    (flush-output)
     (case (vbox-state vbox)
       [(running) (void)]
       [(paused) (vbox-control vbox "resume")]
@@ -169,6 +171,7 @@
   (define vbox (get-opt c '#:vbox))
   (when vbox
     (printf "Stopping VirtualBox machine ~s\n" vbox)
+    (flush-output)
     (vbox-control vbox "savestate")
     (unless (eq? (vbox-state vbox) 'saved)
       (error 'start-client "virtual machine isn't in the expected saved state: ~s" c))))
@@ -355,7 +358,7 @@
     (parameterize ([current-custodian cust])
       (thread (lambda ()
                 (sleep (* timeout-factor timeout))
-                (printf "timeout for ~s\n" (client-name c))
+                (eprintf "timeout for ~s\n" (client-name c))
                 ;; try nice interrupt, first:
                 (set! timeout? #t)
                 (break-thread orig-thread)
@@ -377,6 +380,7 @@
     (define log-file (build-path log-dir (client-name c)))
     (make-directory* log-dir)
     (printf "Logging build: ~a\n" log-file)
+    (flush-output)
     (define (go)
       (define p (open-output-file log-file
                                   #:exists 'truncate/replace))

pkgs/distro-build/manage-snapshots.rkt

@@ -30,6 +30,7 @@
 
 (when (link-exists? link-file)
   (printf "Removing old \"current\" link\n")
+  (flush-output)
   (delete-file link-file))
 
 (define (get-snapshots)
@@ -46,9 +47,11 @@
                               (list-tail (sort snapshots string>?) n)))
     (for ([s (in-list remove-snapshots)])
       (printf "Removing snapshot ~a\n" s)
+      (flush-output)
       (delete-directory/files (build-path snapshots-dir s)))))
 
 (printf "Creating \"current\" link\n")
+(flush-output)
 (make-file-or-directory-link current-snapshot link-file)
 
 (make-download-page (build-path site-dir

pkgs/racket-pkgs/racket-index/setup/scribble.rkt

@@ -44,7 +44,8 @@
   (begin
     (when (verbose)
       (printf (string-append " [" format-str "]\n")
-              arg ...))
+              arg ...)
+      (flush-output))
     (log-setup-debug format-str arg ...)))
 
 (define-serializable-struct doc (src-dir 

racket/collects/pkg/lib.rkt

@@ -59,6 +59,11 @@
                      what
                      (exn-message x)))
 
+(define (printf/flush fmt . args)
+  ;; For status reporting, flush immediately after printing
+  (apply printf fmt args)
+  (flush-output))
+
 (struct pkg-desc (source type name auto?))
 (define (pkg-desc=? a b)
   (define (->list a)
@@ -589,7 +594,7 @@
 
 (define ((remove-package quiet?) pkg-name)
   (unless quiet?
-    (printf "Removing ~a\n" pkg-name))
+    (printf/flush "Removing ~a\n" pkg-name))
   (define db (read-pkg-db))
   (define pi (package-info pkg-name #:db db))
   (match-define (pkg-info orig-pkg checksum _) pi)
@@ -1060,7 +1065,7 @@
          #:install-conversation [install-conversation #f]
          #:update-conversation [update-conversation #f]
          descs)
-  (define download-printf (if quiet? void printf))
+  (define download-printf (if quiet? void printf/flush))
   (define check-sums? (not ignore-checksums?))
   (define all-db (merge-pkg-dbs))
   (define path-pkg-cache (make-hash))
@@ -1081,17 +1086,17 @@
                              (cadddr ud)))))
     (define (show-dependencies deps update? auto? conversation)
       (unless quiet?
-        (printf "The following ~a packages are listed as dependencies of ~a~a:~a\n"
+        (printf/flush "The following ~a packages are listed as dependencies of ~a~a:~a\n"
-                (if update? "out-of-date" "uninstalled")
+                      (if update? "out-of-date" "uninstalled")
-                pkg-name
+                      pkg-name
-                (if (or auto? (eq? conversation 'always-yes))
+                      (if (or auto? (eq? conversation 'always-yes))
-                    (format "\nand they will be ~a~a"
+                          (format "\nand they will be ~a~a"
-                            (if auto? "automatically " "")
+                                  (if auto? "automatically " "")
-                            (if update? "updated" "installed"))
+                                  (if update? "updated" "installed"))
-                    "")
+                          "")
-                (if update?
+                      (if update?
-                    (format-deps deps)
+                          (format-deps deps)
-                    (format-list deps)))))
+                          (format-list deps)))))
     (define simultaneous-installs
       (for/hash ([i (in-list infos)])
         (values (install-info-name i) (install-info-directory i))))
@@ -1545,12 +1550,15 @@
   (define to-update (filter-map (update-package download-printf db) pkgs))
   (cond
     [(empty? to-update)
-     (printf "No updates available\n")
+     (unless quiet?
+       (printf/flush "No updates available\n"))
      'skip]
     [else
-     (printf "Updating:\n")
+     (unless quiet?
-     (for ([u (in-list to-update)])
+       (printf "Updating:\n")
-       (printf "  ~a\n" (pkg-desc-name u)))
+       (for ([u (in-list to-update)])
+         (printf "  ~a\n" (pkg-desc-name u)))
+       (flush-output))
      (pkg-install
       #:updating? #t
       #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
@@ -1641,8 +1649,8 @@
     (match create:format
       ['MANIFEST
        (unless quiet?
-         (printf "creating manifest for ~a\n"
+         (printf/flush "creating manifest for ~a\n"
-                 orig-dir))
+                       orig-dir))
        (with-output-to-file (build-path (or dest-dir dir) "MANIFEST")
          #:exists 'replace
          (λ ()
@@ -1659,11 +1667,11 @@
                                       [else (current-directory)]))))
        (define pkg/complete (path->complete-path pkg actual-dest-dir))
        (unless quiet?
-         (printf "packing~a into ~a\n"
+         (printf/flush "packing~a into ~a\n"
-                 (if hide-src? "" (format " ~a" dir))
+                       (if hide-src? "" (format " ~a" dir))
-                 (if dest-dir
+                       (if dest-dir
-                     pkg/complete
+                           pkg/complete
-                     pkg)))
+                           pkg)))
        (match create:format
          ['tgz
           (when (file-exists? pkg/complete)
@@ -1702,10 +1710,10 @@
        (define chk (format "~a.CHECKSUM" pkg))
        (define chk/complete (path->complete-path chk actual-dest-dir))
        (unless quiet?
-         (printf "writing package checksum to ~a\n"
+         (printf/flush "writing package checksum to ~a\n"
-                 (if dest-dir
+                       (if dest-dir
-                     chk/complete
+                           chk/complete
-                     chk)))
+                           chk)))
        (with-output-to-file chk/complete
          #:exists 'replace
          (λ () (display (call-with-input-file pkg/complete sha1))))])))
@@ -2178,7 +2186,7 @@
             (define ht (hash-ref details name))
             (define source (hash-ref ht 'source))
             (unless quiet?
-              (printf "Downloading ~s\n" source))
+              (printf/flush "Downloading ~s\n" source))
             (define-values (checksum modules deps)
               (get-pkg-content (pkg-desc source
                                          #f 

racket/collects/setup/setup-unit.rkt

@@ -80,7 +80,8 @@
 
   (define (setup-fprintf p task s . args)
     (let ([task (if task (string-append task ": ") "")])
-      (apply fprintf p (string-append name-str ": " task s "\n") args)))
+      (apply fprintf p (string-append name-str ": " task s "\n") args)
+      (flush-output p)))
 
   (define (setup-printf task s . args)
     (apply setup-fprintf (current-output-port) task s args))