me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2022-06-26 16:14:40 +02:00
parent c31605b582
commit f99f00fc81
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
guix/status.scm
View File

@ -667,13 +667,14 @@ case where BV does not contain only valid UTF-8."
(close-port port) (close-port port)
str))))) str)))))
(define (bytevector-index bv number offset count) (define (bytevector-index bv numbers offset count)
"Search for NUMBER in BV starting from OFFSET and reading up to COUNT bytes; "Search for NUMBERS 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." return the offset where one of NUMBERS first occurs or #f if they could not be
found."
(let loop ((offset offset) (let loop ((offset offset)
(count count)) (count count))
(cond ((zero? count) #f) (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)))))) (else (loop (+ 1 offset) (- count 1))))))
(define (split-lines str) (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 '())
(set! %build-output-pid #f)) (set! %build-output-pid #f))
keep) 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) offset count)
((? integer? cr) ((? integer? cr)
(let* ((tail (maybe-utf8->string (let* ((tail (maybe-utf8->string

14
tests/status.scm
View File

@ -124,6 +124,20 @@
(force-output port) (force-output port)
(get-status))) (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" (test-equal "current-build-output-port, UTF-8 + garbage"
;; What about a mixture of UTF-8 + garbage? ;; What about a mixture of UTF-8 + garbage?
(let ((replacement "<22>")) (let ((replacement "<22>"))