From 73a8681a16869a2b3a9da1c7ba9434e07a204e19 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 27 Jan 2019 22:33:16 +0100
Subject: 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.
---
 tests/status.scm | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

(limited to 'tests')

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")
-- 
cgit v1.2.3