diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-06-26 16:14:40 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-06-26 23:19:14 +0200 |
commit | f99f00fc814a3e1a3e1cedb5059c896e3303677c (patch) | |
tree | 6487e1037b10872cdffc8a7ad607b46b6bb38b6a | |
parent | c31605b58228dbd10c819311a17341a22c9e5118 (diff) | |
download | guix-f99f00fc814a3e1a3e1cedb5059c896e3303677c.tar.gz guix-f99f00fc814a3e1a3e1cedb5059c896e3303677c.zip |
status: Relay "updating substitutes" messages.
Until now, those messages would be accumulated and displayed all at
once, when a '\n' was finally emitted by 'guix substitute'. In the
meantime, clients would remain silent.
* guix/status.scm (bytevector-index): Change 'number' parameter to
'numbers' and adjust accordingly.
(build-event-output-port): Pass both #\newline and #\return to
'bytevector-index'.
* tests/status.scm ("build-output-port, daemon messages with LF"): New
test.
-rw-r--r-- | guix/status.scm | 16 | ||||
-rw-r--r-- | tests/status.scm | 14 |
2 files changed, 25 insertions, 5 deletions
diff --git a/guix/status.scm b/guix/status.scm index b8905c9542..2c69f49fb5 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -667,13 +667,14 @@ case where BV does not contain only valid UTF-8." (close-port port) str))))) -(define (bytevector-index bv number offset count) - "Search for NUMBER in BV starting from OFFSET and reading up to COUNT bytes; -return the offset where NUMBER first occurs or #f if it could not be found." +(define (bytevector-index bv numbers offset count) + "Search for NUMBERS in BV starting from OFFSET and reading up to COUNT bytes; +return the offset where one of NUMBERS first occurs or #f if they could not be +found." (let loop ((offset offset) (count count)) (cond ((zero? count) #f) - ((= (bytevector-u8-ref bv offset) number) offset) + ((memv (bytevector-u8-ref bv offset) numbers) offset) (else (loop (+ 1 offset) (- count 1)))))) (define (split-lines str) @@ -774,7 +775,12 @@ The second return value is a thunk to retrieve the current state." (set! %build-output '()) (set! %build-output-pid #f)) keep) - (match (bytevector-index bv (char->integer #\newline) + + ;; Search for both '\n' and '\r'; the latter is appears in progress + ;; messages sent by 'guix substitute' through the daemon. + (match (bytevector-index bv + (list (char->integer #\newline) + (char->integer #\return)) offset count) ((? integer? cr) (let* ((tail (maybe-utf8->string diff --git a/tests/status.scm b/tests/status.scm index 79024ba2b3..b0af619872 100644 --- a/tests/status.scm +++ b/tests/status.scm @@ -124,6 +124,20 @@ (force-output port) (get-status))) +(test-equal "build-output-port, daemon messages with LF" + '((build-log #f "updating substitutes... 0%\r") + (build-log #f "updating substitutes... 50%\r") + (build-log #f "updating substitutes... 100%\r")) + (let ((port get-status (build-event-output-port cons '()))) + (for-each (lambda (suffix) + (let ((bv (string->utf8 + (string-append "updating substitutes... " + suffix "\r")))) + (put-bytevector port bv) + (force-output port))) + '("0%" "50%" "100%")) + (reverse (get-status)))) + (test-equal "current-build-output-port, UTF-8 + garbage" ;; What about a mixture of UTF-8 + garbage? (let ((replacement "�")) |