diff options
| -rw-r--r-- | src/cuirass/database.scm | 17 | ||||
| -rw-r--r-- | 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'~@[, 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))) |