summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-09-15 17:40:05 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-09-15 17:40:05 +0200
commit7642748398c69c9740ec3c3532bd88c5ea0615e4 (patch)
tree13527c303c9f492808afb2a2221a66613c84aeb3
parentf3ab04aee4ee2d0fa1f5894e1cf9b068716ecf00 (diff)
downloadcuirass-7642748398c69c9740ec3c3532bd88c5ea0615e4.tar
cuirass-7642748398c69c9740ec3c3532bd88c5ea0615e4.tar.gz
Add metrics testing.
* tests/metrics.scm: New file. * Makefile.am (TESTS): Add it.
-rw-r--r--Makefile.am1
-rw-r--r--tests/metrics.scm137
2 files changed, 138 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index df24342..0e4d3c8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -115,6 +115,7 @@ TESTS = \
## tests/basic.sh # takes too long to execute
tests/database.scm \
tests/http.scm \
+ tests/metrics.scm \
tests/ui.scm \
tests/utils.scm
diff --git a/tests/metrics.scm b/tests/metrics.scm
new file mode 100644
index 0000000..8859084
--- /dev/null
+++ b/tests/metrics.scm
@@ -0,0 +1,137 @@
+;;;; database.scm - tests for (cuirass metrics) module
+;;;
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (cuirass database)
+ (cuirass metrics)
+ (cuirass utils)
+ ((guix utils) #:select (call-with-temporary-output-file))
+ (srfi srfi-64))
+
+(define (nearest-exact-integer x)
+ "Given a real number X, return the nearest exact integer, with ties going to
+the nearest exact even integer."
+ (inexact->exact (round x)))
+
+(define-syntax-rule (with-temporary-database body ...)
+ (call-with-temporary-output-file
+ (lambda (file port)
+ (parameterize ((%package-database file))
+ (db-init file)
+ (with-database
+ body ...)))))
+
+(define today
+ (let ((time (current-time)))
+ (- time (modulo time 86400))))
+
+(define yesterday
+ (- today 86400))
+
+(define %db
+ ;; Global Slot for a database object.
+ (make-parameter #t))
+
+(define database-name
+ ;; Use an empty and temporary database for the tests.
+ (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
+
+(test-group-with-cleanup "database"
+ (test-assert "db-init"
+ (begin
+ (%db (db-init database-name))
+ (%db-channel (make-worker-thread-channel
+ (lambda ()
+ (list (%db)))))
+ #t))
+
+ (test-assert "sqlite-exec"
+ (begin
+ (sqlite-exec (%db) "\
+INSERT INTO Evaluations (specification, status,
+timestamp, checkouttime, evaltime) VALUES ('guix', -1, 1600174547, 0, 0);")
+ (sqlite-exec (%db) "\
+INSERT INTO Evaluations (specification, status,
+timestamp, checkouttime, evaltime) VALUES ('guix', 0, 1600174547, 1600174548,
+1600260947);")
+ (sqlite-exec (%db) "\
+INSERT INTO Evaluations (specification, status,
+timestamp, checkouttime, evaltime) VALUES ('guix', 1, 1600174547,
+1600174548, 0);")
+ (sqlite-exec (%db) "\
+INSERT INTO Evaluations (specification, status,
+timestamp, checkouttime, evaltime) VALUES ('guix', 2, 1600174547,
+1600174548, 0);")
+ (sqlite-exec (%db) (format #f "\
+INSERT INTO Builds (id, derivation, evaluation, job_name, system,
+nix_name, log, status, timestamp, starttime, stoptime) VALUES
+(1, '/gnu/store/xxx.drv', 1, '', '', '', '', 0, ~a, ~a, ~a);\
+" yesterday (+ yesterday 500) (+ yesterday 1500)))
+ (sqlite-exec (%db) (format #f "\
+INSERT INTO Builds (id, derivation, evaluation, job_name, system,
+nix_name, log, status, timestamp, starttime, stoptime) VALUES
+(2, '/gnu/store/yyy.drv', 1, '', '', '', '', -2, 0, 0, 0);"))))
+
+ (test-equal "average-eval-duration-per-spec"
+ `(("guix" . 86400.0))
+ (begin
+ (db-update-metric 'average-eval-duration-per-spec "guix")
+ (db-get-metrics-with-id 'average-eval-duration-per-spec)))
+
+ (test-equal "builds-per-day"
+ 1.0
+ (begin
+ (db-update-metric 'builds-per-day)
+ (db-get-metric 'builds-per-day yesterday)))
+
+ (test-equal "pending-builds"
+ `((,today . 1.0))
+ (begin
+ (db-update-metric 'pending-builds)
+ (db-get-metrics-with-id 'pending-builds)))
+
+ (test-equal "new-derivations-per-day"
+ `((,yesterday . 1.0))
+ (begin
+ (db-update-metric 'new-derivations-per-day)
+ (db-get-metrics-with-id 'new-derivations-per-day)))
+
+ (test-equal "percentage-failed-eval-per-spec"
+ `(("guix" . 50.0))
+ (begin
+ (db-update-metric 'percentage-failed-eval-per-spec "guix")
+ (db-get-metrics-with-id 'percentage-failed-eval-per-spec)))
+
+ (test-assert "db-update-metrics"
+ (begin
+ (db-update-metrics)
+ (equal? (db-get-metric 'average-10-last-eval-duration-per-spec
+ "guix")
+ (db-get-metric 'average-100-last-eval-duration-per-spec
+ "guix"))))
+
+ (test-assert "db-close"
+ (db-close (%db)))
+
+ (begin
+ (%db-channel #f)
+ (delete-file database-name)))
+
+;;; Local Variables:
+;;; eval: (put 'with-temporary-database 'scheme-indent-function 0)
+;;; End: