summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-06-26 16:14:40 +0200
committerLudovic Courtès <ludo@gnu.org>2022-06-26 23:19:14 +0200
commitf99f00fc814a3e1a3e1cedb5059c896e3303677c (patch)
tree6487e1037b10872cdffc8a7ad607b46b6bb38b6a
parentstatus: Change tests from SRFI-11 to SRFI-71. (diff)
downloadguix-f99f00fc814a3e1a3e1cedb5059c896e3303677c.tar.gz
guix-f99f00fc814a3e1a3e1cedb5059c896e3303677c.tar.bz2
guix-f99f00fc814a3e1a3e1cedb5059c896e3303677c.tar.xz
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.scm16
-rw-r--r--tests/status.scm14
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."
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;
672return the offset where NUMBER first occurs or #f if it could not be found." 672return the offset where one of NUMBERS first occurs or #f if they could not be
673found."
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 79024ba2b3..b0af619872 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 "�"))