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.
This commit is contained in:
Ludovic Courtès 2015-04-04 21:59:25 +02:00
parent e740a90228
commit 9ed86fe175
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
6 changed files with 25 additions and 40 deletions

View File

@ -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.

View File

@ -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)

View File

@ -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")

View File

@ -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"

View File

@ -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

View File

@ -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")