[no subject]

[Ludovic Court�s]

branch: master
commit 8675d6309b0576cdca7d5b607a358fd37982bfe7
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jan 24 23:40:07 2018 +0100

    database: 'db-update-build-status!' takes a #:log-file parameter.
    
    * src/cuirass/database.scm (sqlite-exec): Use (ice-9 format).
    (db-update-build-status!): Add #:log-file parameter and honor it.
    * tests/database.scm ("database")["db-update-build-status!"]: Test it.
---
 src/cuirass/database.scm | 17 +++++++++--------
 tests/database.scm       | 11 +++++++----
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 4b6b062..539aa31 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -22,6 +22,7 @@
   #:use-module (cuirass config)
   #:use-module (cuirass utils)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
@@ -54,9 +55,8 @@
 
 (define (sqlite-exec db msg . args)
   "Wrap 'sqlite-prepare', 'sqlite-step', and 'sqlite-finalize'. Send message
-MSG to database DB.  MSG can contain '~A' and '~S' escape characters which
-will be replaced by ARGS."
-  (let* ((sql  (apply simple-format #f msg args))
+MSG to database DB.  MSG and ARGS are passed to 'format'."
+  (let* ((sql  (apply format #f msg args))
          (stmt (sqlite-prepare db sql))
          (res  (let loop ((res '()))
                  (let ((row (sqlite-step stmt)))
@@ -236,9 +236,10 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', 
'~A', '~A');"
               (assq-ref build #:outputs))
     build-id))
 
-(define (db-update-build-status! db drv status)
+(define* (db-update-build-status! db drv status #:key log-file)
   "Update DB so that DRV's status is STATUS.  This also updates the
-'starttime' or 'stoptime' fields."
+'starttime' or 'stoptime' fields.  If LOG-FILE is true, record it as the build
+log file for DRV."
   (define now
     (time-second (current-time time-utc)))
 
@@ -246,9 +247,9 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', 
'~A');"
       (sqlite-exec db "UPDATE Builds SET starttime='~A', status='~A' \
 WHERE derivation='~A';"
                    now status drv)
-      (sqlite-exec db "UPDATE Builds SET stoptime='~A', status='~A' \
-WHERE derivation='~A';"
-                   now status drv)))
+      (sqlite-exec db "UPDATE Builds SET stoptime='~A', \
+status='~A'address@hidden, log='~A'~] WHERE derivation='~A';"
+                   now status log-file drv)))
 
 (define (db-get-outputs db build-id)
   "Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
diff --git a/tests/database.scm b/tests/database.scm
index 28a7e46..217ddde 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -146,7 +146,8 @@ INSERT INTO Evaluations (specification, revision) VALUES 
(3, 3);")
   (test-equal "db-update-build-status!"
     (list (build-status scheduled)
           (build-status started)
-          (build-status succeeded))
+          (build-status succeeded)
+          "/foo.drv.log")
     (with-temporary-database db
       (let* ((id (db-add-build
                   db
@@ -161,12 +162,14 @@ INSERT INTO Evaluations (specification, revision) VALUES 
(3, 3);")
         (let ((status0 (get-status)))
           (db-update-build-status! db "/foo.drv" (build-status started))
           (let ((status1 (get-status)))
-            (db-update-build-status! db "/foo.drv" (build-status succeeded))
+            (db-update-build-status! db "/foo.drv" (build-status succeeded)
+                                     #:log-file "/foo.drv.log")
             (let ((status2 (get-status))
                   (start   (get-status #:starttime))
-                  (end     (get-status #:stoptime)))
+                  (end     (get-status #:stoptime))
+                  (log     (get-status #:log)))
               (and (> start 0) (>= end start)
-                   (list status0 status1 status2))))))))
+                   (list status0 status1 status2 log))))))))
 
   (test-assert "db-close"
     (db-close (%db)))