summaryrefslogtreecommitdiff
path: root/tests/status.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-27 22:33:16 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-29 12:09:52 +0100
commit73a8681a16869a2b3a9da1c7ba9434e07a204e19 (patch)
treef41e23ad2fb1376c7f329bc71438070c688de3c9 /tests/status.scm
parent976ef2d97887d16eab8d4eb9dad811786b04d690 (diff)
downloadpatches-73a8681a16869a2b3a9da1c7ba9434e07a204e19.tar
patches-73a8681a16869a2b3a9da1c7ba9434e07a204e19.tar.gz
status: Keep track of build completion as reported by build tools.
* guix/status.scm (<build>)[completion]: New field. (build): Add #:completion parameter. (%percentage-line-rx, %fraction-line-rx): New variables. (update-build): New procedure. (compute-status): Add 'build-log' case. * tests/status.scm ("compute-status, build completion"): New test.
Diffstat (limited to 'tests/status.scm')
-rw-r--r--tests/status.scm31
1 files changed, 31 insertions, 0 deletions
diff --git a/tests/status.scm b/tests/status.scm
index e3ea768968..f3afadfcd0 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -180,4 +180,35 @@
(display "@ build-succeeded bar.drv\n" port)
(list first second (get-status))))))
+(test-equal "compute-status, build completion"
+ (list (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 0.))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 50.))))
+ (build-status
+ (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 100.)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now))))))
+ (display "@ build-started foo.drv - x86_64-linux 121\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 20\n[ 0/100] building X\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((second (get-status)))
+ (display "@ build-log 121 20\n[50/100] building Y\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((third (get-status)))
+ (display "@ build-log 121 21\n[100/100] building Z\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (display "@ build-succeeded foo.drv\n" port)
+ (list first second third (get-status)))))))
+
(test-end "status")