aboutsummaryrefslogtreecommitdiff
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
parentc7465dcb96e8d35fb992f4e14c4e22251b951a98 (diff)
downloadguix-ba514b601ba6be15b823e0a12d4b6e42f9d2489e.tar
guix-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
-rw-r--r--guix/status.scm28
-rw-r--r--tests/status.scm33
2 files changed, 58 insertions, 3 deletions
diff --git a/guix/status.scm b/guix/status.scm
index 070071d46f..c3c219219d 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -55,6 +55,9 @@
build
build-derivation
build-system
+ build-log-file
+ build-phase
+ build-completion
download?
download
@@ -102,18 +105,20 @@
;; On-going or completed build.
(define-immutable-record-type <build>
- (%build derivation id system log-file completion)
+ (%build derivation id system log-file phase completion)
build?
(derivation build-derivation) ;string (.drv file name)
(id build-id) ;#f | integer
(system build-system) ;string
(log-file build-log-file) ;#f | string
+ (phase build-phase ;#f | symbol
+ set-build-phase)
(completion build-completion ;#f | integer (percentage)
set-build-completion))
-(define* (build derivation system #:key id log-file completion)
+(define* (build derivation system #:key id log-file phase completion)
"Return a new build."
- (%build derivation id system log-file completion))
+ (%build derivation id system log-file phase completion))
;; On-going or completed downloads. Downloads can be stem from substitutes
;; and from "builtin:download" fixed-output derivations.
@@ -144,6 +149,10 @@
(lambda (download)
(string=? item (download-item download))))
+(define %phase-start-rx
+ ;; Match the "starting phase" message emitted by 'gnu-build-system'.
+ (make-regexp "^starting phase [`']([^']+)'"))
+
(define %percentage-line-rx
;; Things like CMake write lines like "[ 10%] gcc -c …". This regexp
;; matches them.
@@ -185,6 +194,19 @@ a completion indication."
(let ((done (string->number (match:substring match 1)))
(total (string->number (match:substring match 3))))
(update (* 100. (/ done total))))))
+ ((regexp-exec %phase-start-rx line)
+ =>
+ (lambda (match)
+ (let ((phase (match:substring match 1))
+ (build (find-build)))
+ (if build
+ (build-status
+ (inherit status)
+ (building
+ (cons (set-build-phase (set-build-completion build #f)
+ (string->symbol phase))
+ (delq build (build-status-building status)))))
+ status))))
(else
status)))
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")