[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: tests: Add 'test-assertm' to (guix tests).
From: |
Ludovic Courtès |
Subject: |
01/02: tests: Add 'test-assertm' to (guix tests). |
Date: |
Mon, 12 Nov 2018 17:39:05 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 9ed86fe175c15c819d6d86681c8136ff6bc927c0
Author: Ludovic Courtès <address@hidden>
Date: Sat Apr 4 21:59:25 2015 +0200
tests: Add 'test-assertm' to (guix tests).
* guix/tests.scm (test-assertm): New macro.
* tests/gexp.scm (test-assertm): Remove.
* tests/profiles.scm (test-assertm): Remove.
* tests/challenge.scm (%store, test-assertm): Remove.
* tests/debug-link.scm (%store, test-assertm): Remove.
* tests/size.scm (%store, test-assertm): Remove.
---
guix/tests.scm | 25 +++++++++++++++++++++++++
tests/challenge.scm | 8 --------
tests/debug-link.scm | 8 --------
tests/gexp.scm | 5 -----
tests/profiles.scm | 11 -----------
tests/size.scm | 8 --------
6 files changed, 25 insertions(+), 40 deletions(-)
diff --git a/guix/tests.scm b/guix/tests.scm
index bcf9b99..66524dd 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -27,6 +27,7 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (web uri)
@@ -39,6 +40,8 @@
shebang-too-long?
mock
%test-substitute-urls
+ test-assertm
+ test-equalm
%substitute-directory
with-derivation-narinfo
with-derivation-substitute
@@ -161,6 +164,28 @@ given by REPLACEMENT."
(lambda () body ...)
(lambda () (module-set! m 'proc original)))))
+(define-syntax-rule (test-assertm name exp)
+ "Like 'test-assert', but EXP is a monadic value. A new connection to the
+store is opened."
+ (test-assert name
+ (let ((store (open-connection-for-tests)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (run-with-store store exp
+ #:guile-for-build (%guile-for-build)))
+ (lambda ()
+ (close-connection store))))))
+
+(define-syntax-rule (test-equalm name value exp)
+ "Like 'test-equal', but EXP is a monadic value. A new connection to the
+store is opened."
+ (test-equal name
+ value
+ (with-store store
+ (run-with-store store exp
+ #:guile-for-build (%guile-for-build)))))
+
;;;
;;; Narinfo files, as used by the substituter.
diff --git a/tests/challenge.scm b/tests/challenge.scm
index 4b13ec2..c962800 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -31,17 +31,9 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match))
-(define %store
- (open-connection-for-tests))
-
(define query-path-hash*
(store-lift query-path-hash))
-(define-syntax-rule (test-assertm name exp)
- (test-assert name
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
(define* (call-with-derivation-narinfo* drv thunk hash)
(lambda (store)
(with-derivation-narinfo drv (sha256 => hash)
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index 2dde3cb..a1ae4f1 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -43,14 +43,6 @@
(define read-elf
(compose parse-elf get-bytevector-all))
-(define %store
- (open-connection-for-tests))
-
-(define-syntax-rule (test-assertm name exp)
- (test-assert name
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
(test-begin "debug-link")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 467370f..ab60bda 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -62,11 +62,6 @@
#:target target)
#:guile-for-build (%guile-for-build)))
-(define-syntax-rule (test-assertm name exp)
- (test-assert name
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
(define %extension-package
;; Example of a package to use when testing 'with-extensions'.
(dummy-package "extension"
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 9f366a0..1f9bbd0 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -47,17 +47,6 @@
;; Globally disable grafts because they can trigger early builds.
(%graft? #f)
-(define-syntax-rule (test-assertm name exp)
- (test-assert name
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
-(define-syntax-rule (test-equalm name value exp)
- (test-equal name
- value
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
;; Example manifest entries.
(define guile-1.8.8
diff --git a/tests/size.scm b/tests/size.scm
index 575b1ab..0aaa8fb 100644
--- a/tests/size.scm
+++ b/tests/size.scm
@@ -30,14 +30,6 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
-(define %store
- (open-connection-for-tests))
-
-(define-syntax-rule (test-assertm name exp)
- (test-assert name
- (run-with-store %store exp
- #:guile-for-build (%guile-for-build))))
-
(test-begin "size")