diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-23 18:15:42 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-23 18:17:31 +0100 |
commit | fe0a98315d76dee63a0c0990c8b99ec0154d8a50 (patch) | |
tree | 241869ab1bf6c9bf09635e7cfdd3859329b2457d /tests | |
parent | dbc6625ac246a53a7938db803e1367636f8f49ee (diff) | |
download | cuirass-fe0a98315d76dee63a0c0990c8b99ec0154d8a50.tar cuirass-fe0a98315d76dee63a0c0990c8b99ec0154d8a50.tar.gz |
database: Add 'db-update-build-status!'.
* src/cuirass/database.scm (build-status): Add 'scheduled' and
'started'.
(db-add-build): Make sure #:timestamp, #:starttime, #:stoptime, and
#:status are integers.
(db-update-build-status!): New procedure.
* tests/database.scm ("database")["db-update-build-status!"]: New test.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/database.scm | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/tests/database.scm b/tests/database.scm index d0838eb..28a7e46 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -143,6 +143,31 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);") (map summarize (db-get-builds db '())) (map summarize (db-get-builds db '((nr 1)))))))) + (test-equal "db-update-build-status!" + (list (build-status scheduled) + (build-status started) + (build-status succeeded)) + (with-temporary-database db + (let* ((id (db-add-build + db + (make-dummy-build 1 #:drv "/foo.drv" + #:outputs '(("out" . "/foo"))))) + (get-status (lambda* (#:optional (key #:status)) + (assq-ref (db-get-build db id) key)))) + (db-add-derivation db (make-dummy-derivation "/foo.drv" 1)) + (db-add-evaluation db (make-dummy-eval)) + (db-add-specification db example-spec) + + (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)) + (let ((status2 (get-status)) + (start (get-status #:starttime)) + (end (get-status #:stoptime))) + (and (> start 0) (>= end start) + (list status0 status1 status2)))))))) + (test-assert "db-close" (db-close (%db))) |