[no subject]

[Ludovic Courtès]

branch: master
commit 60b6c6fcc5dd3a9becded4ace160746fb0d9e548
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jan 7 10:19:56 2018 +0100

    database: Extend and test 'db-get-builds'.
    
    * src/cuirass/database.scm (db-get-builds): Make 'order' a separate
    filter.  Add 'format-limit-clause'.  Reverse OUTPUTS.
    * tests/database.scm (make-dummy-eval, make-dummy-derivation)
    (make-dummy-build): New procedures.
    (with-temporary-database): New macro.
    ("database"): Use 'make-dummy-build'.
    ("db-get-builds"): New test.
---
 src/cuirass/database.scm | 34 ++++++++++++++++--------
 tests/database.scm       | 67 +++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 87 insertions(+), 14 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 0c7c8f8..a00023a 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1,6 +1,7 @@
 ;;; database.scm -- store evaluation and build results
 ;;; Copyright © 2016, 2017 Mathieu Lirzin <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -270,7 +271,7 @@ INNER JOIN Specifications ON Evaluations.specification = 
Specifications.repo_nam
 (define (db-get-builds db filters)
   "Retrieve all builds in database DB which are matched by given FILTERS.
 FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
-'system | 'nr."
+'system | 'nr | 'order."
 
   (define (format-where-clause filters)
     (let ((where-clause
@@ -294,13 +295,22 @@ FILTERS is an assoc list which possible keys are 'project 
| 'jobset | 'job |
           "")))
 
   (define (format-order-clause filters)
-    (any
-     (lambda (param)
-       (match param
-         (('nr number)
-          (format #f "ORDER BY Builds.id DESC LIMIT '~A';" number))
-         (_ #f)))
-     filters))
+    (or (any (match-lambda
+               (('order 'build-id)
+                "ORDER BY Builds.id ASC")
+               (('order 'decreasing-build-id)
+                "ORDER BY Builds.id DESC")
+               (_ #f))
+             filters)
+        "ORDER BY Builds.id DESC"))               ;default order
+
+  (define (format-limit-clause filters)
+    (or (any (match-lambda
+               (('nr number)
+                (format #f "LIMIT '~A'" number))
+               (_ #f))
+             filters)
+        ""))
 
   (let loop ((rows
               (sqlite-exec db (string-append
@@ -308,10 +318,14 @@ FILTERS is an assoc list which possible keys are 'project 
| 'jobset | 'job |
                                " "
                                (format-where-clause filters)
                                " "
-                               (format-order-clause filters))))
+                               (format-order-clause filters)
+                               " "
+                               (format-limit-clause filters)
+                               ";")))
              (outputs '()))
     (match rows
-      (() outputs)
+      (()
+       (reverse outputs))
       ((row . rest)
        (loop rest
              (cons (db-format-build db row) outputs))))))
diff --git a/tests/database.scm b/tests/database.scm
index 061ba76..170a6dc 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -1,6 +1,7 @@
 ;;;; database.scm - tests for (cuirass database) module
 ;;;
 ;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -18,6 +19,7 @@
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules (cuirass database)
+             ((guix utils) #:select (call-with-temporary-output-file))
              (srfi srfi-64))
 
 (define example-spec
@@ -32,11 +34,38 @@
     (#:commit . #f)
     (#:no-compile? . #f)))
 
+(define* (make-dummy-eval #:optional (revision "cabba3e"))
+  `((#:specification . "guix")
+    (#:revision . ,revision)))
+
 (define* (make-dummy-job #:optional (name "foo"))
   `((#:name . ,name)
     (#:derivation . ,(string-append name ".drv"))
     (#:specification 0)))
 
+(define* (make-dummy-derivation drv #:optional (eval-id 0))
+  `((#:derivation . ,drv)
+    (#:job-name . "job")
+    (#:system . "x86_64-linux")
+    (#:nix-name . ,(basename drv ".drv"))
+    (#:eval-id . ,eval-id)))
+
+(define* (make-dummy-build #:optional (eval-id 42)
+                           #:key (drv "/foo.drv")
+                           (outputs '(("foo" . "/foo"))))
+  `((#:derivation . ,drv)
+    (#:eval-id . ,eval-id)
+    (#:log . "log")
+    (#:outputs . (("foo" . "/foo")))))
+
+(define-syntax-rule (with-temporary-database db body ...)
+  (call-with-temporary-output-file
+   (lambda (file port)
+     (parameterize ((%package-database file))
+       (db-init file)
+       (with-database db
+         body ...)))))
+
 (define %db
   ;; Global Slot for a database object.
   (make-parameter #t))
@@ -79,16 +108,46 @@ INSERT INTO Evaluations (specification, revision) VALUES 
(3, 3);")
     (db-get-derivation (%db) (%id)))
 
   (test-assert "db-add-build"
-    (let ((build `((#:derivation . "/foo.drv")
-                   (#:eval-id . 42)
-                   (#:log . "log")
-                   (#:outputs . (("foo" . "/foo"))))))
+    (let ((build (make-dummy-build)))
       (db-add-build (%db) build)
 
       ;; 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")))                              ;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 '((nr 1))))))))
+
   (test-assert "db-close"
     (db-close (%db)))
 
   (delete-file database-name))
+
+;;; Local Variables:
+;;; (put 'with-temporary-database 'scheme-indent-function 1)
+;;; End: