diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-04-04 21:59:25 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-11-12 23:37:13 +0100 |
commit | 9ed86fe175c15c819d6d86681c8136ff6bc927c0 (patch) | |
tree | 15403c26a4048013764c36f40d7e97d5d0066b7d | |
parent | e740a902281bb3bde369cc04f26656de608d3614 (diff) | |
download | guix-9ed86fe175c15c819d6d86681c8136ff6bc927c0.tar.gz |
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.
-rw-r--r-- | guix/tests.scm | 25 | ||||
-rw-r--r-- | tests/challenge.scm | 8 | ||||
-rw-r--r-- | tests/debug-link.scm | 8 | ||||
-rw-r--r-- | tests/gexp.scm | 5 | ||||
-rw-r--r-- | tests/profiles.scm | 11 | ||||
-rw-r--r-- | tests/size.scm | 8 |
6 files changed, 25 insertions, 40 deletions
diff --git a/guix/tests.scm b/guix/tests.scm index bcf9b990e5..66524ddc2f 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 4b13ec278e..c962800f3f 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 2dde3cb460..a1ae4f141c 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 467370f8cb..ab60bdab68 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 9f366a04ef..1f9bbd099d 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 575b1abfdd..0aaa8fbc29 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") |