summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-02-05 11:24:44 +0100
committerLudovic Courtès <ludo@gnu.org>2019-02-05 12:03:25 +0100
commitba514b601ba6be15b823e0a12d4b6e42f9d2489e (patch)
tree286c42f6202954263a460f5fe44fd59c76da6a38 /tests
parentc7465dcb96e8d35fb992f4e14c4e22251b951a98 (diff)
downloadpatches-ba514b601ba6be15b823e0a12d4b6e42f9d2489e.tar
patches-ba514b601ba6be15b823e0a12d4b6e42f9d2489e.tar.gz
status: Keep track of the current build phase.
* guix/status.scm (<build>)[phase]: New field. (%phase-start-rx): New variable. (update-build): Add clause to match %PHASE-START-RX and adjust the 'phase' field accordingly. * tests/status.scm ("compute-status, build phase"): Add test
Diffstat (limited to 'tests')
-rw-r--r--tests/status.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/tests/status.scm b/tests/status.scm
index f3afadfcd0..01a61f7345 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -211,4 +211,37 @@
(display "@ build-succeeded foo.drv\n" port)
(list first second third (get-status)))))))
+(test-equal "compute-status, build phase"
+ (list (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'configure))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'configure
+ #:completion 50.))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'install))))
+ (build-status
+ (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'install)))))
+ (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 27\nstarting phase `configure'\n" port)
+ (display "@ build-log 121 6\nabcde!" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 20\n[50/100] building Y\n" port)
+ (display "@ build-log 121 6\nfghik!" port)
+ (let ((second (get-status)))
+ (display "@ build-log 121 21\n[100/100] building Z\n" port)
+ (display "@ build-log 121 25\nstarting phase `install'\n" port)
+ (display "@ build-log 121 6\nlmnop!" port)
+ (let ((third (get-status)))
+ (display "@ build-succeeded foo.drv\n" port)
+ (list first second third (get-status)))))))
+
(test-end "status")