summaryrefslogtreecommitdiff
path: root/tests/database.scm
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-06-26 18:40:31 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-06-26 22:54:49 +0200
commit5ff38984e8a0b26bf3b97477158f55b3721ee2da (patch)
tree59adfad649f9cb44d50b4f512f17c6c8fccd7c82 /tests/database.scm
parent5efdcb444139d6d9354c3aa740c3218beee75646 (diff)
downloadcuirass-5ff38984e8a0b26bf3b97477158f55b3721ee2da.tar
cuirass-5ff38984e8a0b26bf3b97477158f55b3721ee2da.tar.gz
Make %package-database a parameter object.
Move it to (cuirass database).
Diffstat (limited to 'tests/database.scm')
-rw-r--r--tests/database.scm51
1 files changed, 28 insertions, 23 deletions
diff --git a/tests/database.scm b/tests/database.scm
index bdf0050..8c6efc0 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -26,26 +26,31 @@
#:derivation (string-append name ".drv")
#:metadata '()))
-(define tmp-database
- (let ((dir (dirname (current-filename))))
- (string-append dir "/tmp.db")))
-
-(define %db (make-parameter #t))
-(define %id (make-parameter #t))
-
-(dynamic-wind
- (const #t)
- (λ ()
- (test-assert "db-init"
- (%db (db-init tmp-database)))
-
- (test-assert "db-add-evaluation"
- (%id (db-add-evaluation (%db) (make-dummy-job))))
-
- (test-assert "db-get-evaluation"
- (db-get-evaluation (%db) (%id)))
-
- (test-assert "db-close"
- (db-close (%db))))
- (λ ()
- (delete-file tmp-database)))
+(define %db
+ ;; Global Slot for a database object.
+ (make-parameter #t))
+
+(define %id
+ ;; Global Slot for a job ID in the database.
+ (make-parameter #t))
+
+(parameterize ((%package-database
+ ;; Use an empty and temporary database for the tests.
+ (let ((dir (dirname (current-filename))))
+ (string-append dir "/tmp.db"))))
+ (dynamic-wind
+ (const #t)
+ (λ ()
+ (test-assert "db-init"
+ (%db (db-init)))
+
+ (test-assert "db-add-evaluation"
+ (%id (db-add-evaluation (%db) (make-dummy-job))))
+
+ (test-assert "db-get-evaluation"
+ (db-get-evaluation (%db) (%id)))
+
+ (test-assert "db-close"
+ (db-close (%db))))
+ (λ ()
+ (delete-file (%package-database)))))