diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-02-05 11:24:44 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-02-05 12:03:25 +0100 |
commit | ba514b601ba6be15b823e0a12d4b6e42f9d2489e (patch) | |
tree | 286c42f6202954263a460f5fe44fd59c76da6a38 /tests | |
parent | c7465dcb96e8d35fb992f4e14c4e22251b951a98 (diff) | |
download | patches-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.scm | 33 |
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") |