diff options
| -rw-r--r-- | src/cuirass/database.scm | 24 | ||||
| -rw-r--r-- | tests/database.scm | 74 |
2 files changed, 52 insertions, 46 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index d0c169b..b445719 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -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) diff --git a/tests/database.scm b/tests/database.scm index 902c94e..f534f2b 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -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))) |