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) | |
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 b8905c95422..2c69f49fb5c 100644 --- a/guix/status.scm +++ b/guix/status.scm | |||
| @@ -667,13 +667,14 @@ case where BV does not contain only valid UTF-8." | |||
| 667 | (close-port port) | 667 | (close-port port) |
| 668 | str))))) | 668 | str))))) |
| 669 | 669 | ||
| 670 | (define (bytevector-index bv number offset count) | 670 | (define (bytevector-index bv numbers offset count) |
| 671 | "Search for NUMBER in BV starting from OFFSET and reading up to COUNT bytes; | 671 | "Search for NUMBERS in BV starting from OFFSET and reading up to COUNT bytes; |
| 672 | return the offset where NUMBER first occurs or #f if it could not be found." | 672 | return the offset where one of NUMBERS first occurs or #f if they could not be |
| 673 | found." | ||
| 673 | (let loop ((offset offset) | 674 | (let loop ((offset offset) |
| 674 | (count count)) | 675 | (count count)) |
| 675 | (cond ((zero? count) #f) | 676 | (cond ((zero? count) #f) |
| 676 | ((= (bytevector-u8-ref bv offset) number) offset) | 677 | ((memv (bytevector-u8-ref bv offset) numbers) offset) |
| 677 | (else (loop (+ 1 offset) (- count 1)))))) | 678 | (else (loop (+ 1 offset) (- count 1)))))) |
| 678 | 679 | ||
| 679 | (define (split-lines str) | 680 | (define (split-lines str) |
| @@ -774,7 +775,12 @@ The second return value is a thunk to retrieve the current state." | |||
| 774 | (set! %build-output '()) | 775 | (set! %build-output '()) |
| 775 | (set! %build-output-pid #f)) | 776 | (set! %build-output-pid #f)) |
| 776 | keep) | 777 | keep) |
| 777 | (match (bytevector-index bv (char->integer #\newline) | 778 | |
| 779 | ;; Search for both '\n' and '\r'; the latter is appears in progress | ||
| 780 | ;; messages sent by 'guix substitute' through the daemon. | ||
| 781 | (match (bytevector-index bv | ||
| 782 | (list (char->integer #\newline) | ||
| 783 | (char->integer #\return)) | ||
| 778 | offset count) | 784 | offset count) |
| 779 | ((? integer? cr) | 785 | ((? integer? cr) |
| 780 | (let* ((tail (maybe-utf8->string | 786 | (let* ((tail (maybe-utf8->string |
diff --git a/tests/status.scm b/tests/status.scm index 79024ba2b36..b0af6198723 100644 --- a/tests/status.scm +++ b/tests/status.scm | |||
| @@ -124,6 +124,20 @@ | |||
| 124 | (force-output port) | 124 | (force-output port) |
| 125 | (get-status))) | 125 | (get-status))) |
| 126 | 126 | ||
| 127 | (test-equal "build-output-port, daemon messages with LF" | ||
| 128 | '((build-log #f "updating substitutes... 0%\r") | ||
| 129 | (build-log #f "updating substitutes... 50%\r") | ||
| 130 | (build-log #f "updating substitutes... 100%\r")) | ||
| 131 | (let ((port get-status (build-event-output-port cons '()))) | ||
| 132 | (for-each (lambda (suffix) | ||
| 133 | (let ((bv (string->utf8 | ||
| 134 | (string-append "updating substitutes... " | ||
| 135 | suffix "\r")))) | ||
| 136 | (put-bytevector port bv) | ||
| 137 | (force-output port))) | ||
| 138 | '("0%" "50%" "100%")) | ||
| 139 | (reverse (get-status)))) | ||
| 140 | |||
| 127 | (test-equal "current-build-output-port, UTF-8 + garbage" | 141 | (test-equal "current-build-output-port, UTF-8 + garbage" |
| 128 | ;; What about a mixture of UTF-8 + garbage? | 142 | ;; What about a mixture of UTF-8 + garbage? |
| 129 | (let ((replacement "�")) | 143 | (let ((replacement "�")) |
