[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Ludovic Court�s |
Date: |
Thu, 25 Jan 2018 04:42:06 -0500 (EST) |
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)))
- master updated (1d7f4f0 -> 71fb7ea), Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject],
Ludovic Court�s <=
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25
- [no subject], Ludovic Court�s, 2018/01/25