database: 'db-get-builds' honors 'status+submission-time' ordering again.
Fixes a regression introduced in
1bab5c4e56 whereby the
'status+submission-time' order would no longer be honored.
As a result, /api/queue would return the queue ordered by build IDs,
making it largely useless.
* src/cuirass/database.scm (db-get-builds): Remove 'order' and rename
'order-column-name' to 'order'. Add case for 'status+submission-time'.
* tests/database.scm ("database")["db-get-builds"]: Move below
"db-update-build-status!" test. Add case for the
'status+submission-time' order.
This commit is contained in:
Ludovic Courtès
parent
8bdde878c7
commit
8eefd24672
|
|
@ -460,17 +460,17 @@ Assumes that if group id stays the same the group headers stay the same."
|
|||
(let ((x-repeated-row (list->vector other-cells)))
|
||||
(collect-outputs x-builds-id x-repeated-row '() rows)))))
|
||||
|
||||
(let* ((order (if (eq? (assqx-ref filters 'order) 'build-id)
|
||||
"ASC"
|
||||
"DESC"))
|
||||
(order-column-name
|
||||
(match (assqx-ref filters 'order)
|
||||
(('order 'build-id) "Builds.id")
|
||||
(('order 'decreasing-build-id) "Builds.id")
|
||||
(('order 'finish-time) "Builds.stoptime")
|
||||
(('order 'start-time) "Builds.starttime")
|
||||
(('order 'submission-time) "Builds.timestamp")
|
||||
(_ "Builds.id")))
|
||||
(let* ((order (match (assq 'order filters)
|
||||
(('order 'build-id) "Builds.id ASC")
|
||||
(('order 'decreasing-build-id) "Builds.id DESC")
|
||||
(('order 'finish-time) "Builds.stoptime DESC")
|
||||
(('order 'start-time) "Builds.starttime DESC")
|
||||
(('order 'submission-time) "Builds.timestamp DESC")
|
||||
(('order 'status+submission-time)
|
||||
;; With this order, builds in 'running' state (-1) appear
|
||||
;; before those in 'scheduled' state (-2).
|
||||
"Builds.status DESC, Builds.timestamp DESC")
|
||||
(_ "Builds.id DESC")))
|
||||
(stmt-text (format #f "\
|
||||
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\
|
||||
Derivations.job_name, Derivations.system, Derivations.nix_name,\
|
||||
|
|
@ -486,7 +486,7 @@ AND (:jobset IS NULL OR (:jobset = Specifications.branch)) \
|
|||
AND (:job IS NULL OR (:job = Derivations.job_name)) \
|
||||
AND (:system IS NULL OR (:system = Derivations.system)) \
|
||||
AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \
|
||||
ORDER BY ~a ~a, Builds.id ASC LIMIT :nr;" order-column-name order))
|
||||
ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
|
||||
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
|
||||
(sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)
|
||||
#:project (assqx-ref filters 'project)
|
||||
|
|
|
|||
|
|
@ -119,40 +119,6 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
|
|||
;; This should be idempotent, see <https://bugs.gnu.org/28094>.
|
||||
(db-add-build (%db) build)))
|
||||
|
||||
(test-equal "db-get-builds"
|
||||
#(((1 "/foo.drv") (2 "/bar.drv") (3 "/baz.drv")) ;ascending order
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
|
||||
((3 "/baz.drv"))) ;nr = 1
|
||||
(with-temporary-database db
|
||||
;; Populate the 'Builds', 'Derivations', 'Evaluations', and
|
||||
;; 'Specifications' tables in a consistent way, as expected by the
|
||||
;; 'db-get-builds' query.
|
||||
(db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
|
||||
#:outputs `(("out" . "/foo"))))
|
||||
(db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
|
||||
#:outputs `(("out" . "/bar"))))
|
||||
(db-add-build db (make-dummy-build 3 #:drv "/baz.drv"
|
||||
#:outputs `(("out" . "/baz"))))
|
||||
(db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
|
||||
(db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
|
||||
(db-add-derivation db (make-dummy-derivation "/baz.drv" 3))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-specification db example-spec)
|
||||
|
||||
(let ((summarize (lambda (alist)
|
||||
(list (assq-ref alist #:id)
|
||||
(assq-ref alist #:derivation)))))
|
||||
(vector (map summarize (db-get-builds db '((nr 3) (order build-id))))
|
||||
(map summarize (db-get-builds db '()))
|
||||
(map summarize (db-get-builds db '((project "guix"))))
|
||||
(map summarize (db-get-builds db '((project "guix")
|
||||
(jobset "master"))))
|
||||
(map summarize (db-get-builds db '((nr 1))))))))
|
||||
|
||||
(test-equal "db-update-build-status!"
|
||||
(list (build-status scheduled)
|
||||
(build-status started)
|
||||
|
|
@ -186,6 +152,46 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
|
|||
(and (> start 0) (>= end start)
|
||||
(list status0 status1 status2 log))))))))
|
||||
|
||||
(test-equal "db-get-builds"
|
||||
#(((1 "/foo.drv") (2 "/bar.drv") (3 "/baz.drv")) ;ascending order
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
|
||||
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
|
||||
((3 "/baz.drv")) ;nr = 1
|
||||
((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time
|
||||
(with-temporary-database db
|
||||
;; Populate the 'Builds', 'Derivations', 'Evaluations', and
|
||||
;; 'Specifications' tables in a consistent way, as expected by the
|
||||
;; 'db-get-builds' query.
|
||||
(db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
|
||||
#:outputs `(("out" . "/foo"))))
|
||||
(db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
|
||||
#:outputs `(("out" . "/bar"))))
|
||||
(db-add-build db (make-dummy-build 3 #:drv "/baz.drv"
|
||||
#:outputs `(("out" . "/baz"))))
|
||||
(db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
|
||||
(db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
|
||||
(db-add-derivation db (make-dummy-derivation "/baz.drv" 3))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-specification db example-spec)
|
||||
|
||||
(db-update-build-status! db "/bar.drv" (build-status started)
|
||||
#:log-file "/bar.drv.log")
|
||||
|
||||
(let ((summarize (lambda (alist)
|
||||
(list (assq-ref alist #:id)
|
||||
(assq-ref alist #:derivation)))))
|
||||
(vector (map summarize (db-get-builds db '((nr 3) (order build-id))))
|
||||
(map summarize (db-get-builds db '()))
|
||||
(map summarize (db-get-builds db '((project "guix"))))
|
||||
(map summarize (db-get-builds db '((project "guix")
|
||||
(jobset "master"))))
|
||||
(map summarize (db-get-builds db '((nr 1))))
|
||||
(map summarize
|
||||
(db-get-builds db '((order status+submission-time))))))))
|
||||
|
||||
(test-assert "db-close"
|
||||
(db-close (%db)))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue