diff --git a/pkgs/distro-build/drive-clients.rkt b/pkgs/distro-build/drive-clients.rkt index 5b32a050c7..e36da4c2d2 100644 --- a/pkgs/distro-build/drive-clients.rkt +++ b/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)) diff --git a/pkgs/distro-build/manage-snapshots.rkt b/pkgs/distro-build/manage-snapshots.rkt index c1e5bb5e09..9677827ae0 100644 --- a/pkgs/distro-build/manage-snapshots.rkt +++ b/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 diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index 651e02a13e..d70f7194c6 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/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 diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 1ac38e73f3..e059654048 100644 --- a/racket/collects/pkg/lib.rkt +++ b/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" - (if update? "out-of-date" "uninstalled") - pkg-name - (if (or auto? (eq? conversation 'always-yes)) - (format "\nand they will be ~a~a" - (if auto? "automatically " "") - (if update? "updated" "installed")) - "") - (if update? - (format-deps deps) - (format-list deps))))) + (printf/flush "The following ~a packages are listed as dependencies of ~a~a:~a\n" + (if update? "out-of-date" "uninstalled") + pkg-name + (if (or auto? (eq? conversation 'always-yes)) + (format "\nand they will be ~a~a" + (if auto? "automatically " "") + (if update? "updated" "installed")) + "") + (if update? + (format-deps 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") - (for ([u (in-list to-update)]) - (printf " ~a\n" (pkg-desc-name u))) + (unless quiet? + (printf "Updating:\n") + (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" - orig-dir)) + (printf/flush "creating manifest for ~a\n" + 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" - (if hide-src? "" (format " ~a" dir)) - (if dest-dir - pkg/complete - pkg))) + (printf/flush "packing~a into ~a\n" + (if hide-src? "" (format " ~a" dir)) + (if dest-dir + pkg/complete + 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" - (if dest-dir - chk/complete - chk))) + (printf/flush "writing package checksum to ~a\n" + (if dest-dir + chk/complete + 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 diff --git a/racket/collects/setup/setup-unit.rkt b/racket/collects/setup/setup-unit.rkt index 53e1481c07..0a1f8b9c8c 100644 --- a/racket/collects/setup/setup-unit.rkt +++ b/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))