summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-10-15 23:06:55 +0200
committerLudovic Courtès <ludo@gnu.org>2018-10-15 23:06:55 +0200
commitf9a8fce10f2d99efec7cb1dd0f6c5f0df9d1b2df (patch)
treef8c38800ba9582b9212017b154e2e5810bc94488 /tests
parent6ef61cc4c30e94acbd7437f19c893f63a7112267 (diff)
downloadpatches-f9a8fce10f2d99efec7cb1dd0f6c5f0df9d1b2df.tar
patches-f9a8fce10f2d99efec7cb1dd0f6c5f0df9d1b2df.tar.gz
status: Build upon multiplexed build output.
This allows for more accurate status tracking and parsing of extended build traces. * guix/status.scm (multiplexed-output-supported?): New procedure. (print-build-event): Don't print \r when PRINT-LOG? is true. Adjust 'build-log' handling for when 'multiplexed-output-supported?' returns true. (bytevector-index, split-lines): New procedures. (build-event-output-port)[%build-output-pid, %build-output] [%build-output-left]: New variables. [process-line]: Handle "@ build-output" traces. [process-build-output]: New procedure. [write!]: Add case for when %BUILD-OUTPUT-PID is true. Use 'bytevector-index' rather than 'string-index'. (compute-status): Add #:derivation-path->output-path. Use it. * tests/status.scm ("compute-status, multiplexed build output"): New test. ("build-output-port, UTF-8") ("current-build-output-port, UTF-8 + garbage"): Adjust to new 'build-log' output. * guix/scripts/build.scm (set-build-options-from-command-line): Pass #:multiplexed-build-output?. (%default-options): Add 'multiplexed-build-output?'. * guix/scripts/environment.scm (%default-options): Likewise. * guix/scripts/pack.scm (%default-options): Likewise. * guix/scripts/package.scm (%default-options): Likewise. * guix/scripts/pull.scm (%default-options): Likewise. * guix/scripts/system.scm (%default-options): Likewise.
Diffstat (limited to 'tests')
-rw-r--r--tests/status.scm51
1 files changed, 48 insertions, 3 deletions
diff --git a/tests/status.scm b/tests/status.scm
index 486ad04dd2..3b74946673 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -22,7 +22,8 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
- #:use-module (rnrs io ports))
+ #:use-module (rnrs io ports)
+ #:use-module (ice-9 match))
(test-begin "status")
@@ -115,7 +116,7 @@
(list first (get-status)))))
(test-equal "build-output-port, UTF-8"
- '((build-log "lambda is λ!\n"))
+ '((build-log #f "lambda is λ!\n"))
(let-values (((port get-status) (build-event-output-port cons '()))
((bv) (string->utf8 "lambda is λ!\n")))
(put-bytevector port bv)
@@ -124,7 +125,7 @@
(test-equal "current-build-output-port, UTF-8 + garbage"
;; What about a mixture of UTF-8 + garbage?
- '((build-log "garbage: �lambda: λ\n"))
+ '((build-log #f "garbage: �lambda: λ\n"))
(let-values (((port get-status) (build-event-output-port cons '())))
(display "garbage: " port)
(put-bytevector port #vu8(128))
@@ -132,4 +133,48 @@
(force-output port)
(get-status)))
+(test-equal "compute-status, multiplexed build output"
+ (list (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:start 'now))))
+ (build-status
+ (building '("foo.drv"))
+ (downloading (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 42
+ #:start 'now))))
+ (build-status
+ ;; XXX: Should "bar.drv" be present twice?
+ (builds-completed '("bar.drv" "foo.drv"))
+ (downloads-completed (list (download "bar" "http://example.org/bar"
+ #:size 999
+ #:transferred 999
+ #:start 'now
+ #:end 'now)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now)
+ #:derivation-path->output-path
+ (match-lambda
+ ("bar.drv" "bar")))))))
+ (display "@ build-started foo.drv 121\n" port)
+ (display "@ build-started bar.drv 144\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (display "@ build-log 144 50
+@ download-started bar http://example.org/bar 999\n" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 30\n@ build-started FAKE!.drv 555\n")
+ (display "@ build-log 144 54
+@ download-progress bar http://example.org/bar 999 42\n"
+ port)
+ (let ((second (get-status)))
+ (display "@ download-succeeded bar http://example.org/bar 999\n" port)
+ (display "@ build-succeeded foo.drv\n" port)
+ (display "@ build-succeeded bar.drv\n" port)
+ (list first second (get-status))))))
+
(test-end "status")