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:
parent
e740a90228
commit
9ed86fe175
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
|
@ -39,6 +40,8 @@
|
||||||
shebang-too-long?
|
shebang-too-long?
|
||||||
mock
|
mock
|
||||||
%test-substitute-urls
|
%test-substitute-urls
|
||||||
|
test-assertm
|
||||||
|
test-equalm
|
||||||
%substitute-directory
|
%substitute-directory
|
||||||
with-derivation-narinfo
|
with-derivation-narinfo
|
||||||
with-derivation-substitute
|
with-derivation-substitute
|
||||||
|
@ -161,6 +164,28 @@ given by REPLACEMENT."
|
||||||
(lambda () body ...)
|
(lambda () body ...)
|
||||||
(lambda () (module-set! m 'proc original)))))
|
(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.
|
;;; Narinfo files, as used by the substituter.
|
||||||
|
|
|
@ -31,17 +31,9 @@
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
(define %store
|
|
||||||
(open-connection-for-tests))
|
|
||||||
|
|
||||||
(define query-path-hash*
|
(define query-path-hash*
|
||||||
(store-lift 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)
|
(define* (call-with-derivation-narinfo* drv thunk hash)
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(with-derivation-narinfo drv (sha256 => hash)
|
(with-derivation-narinfo drv (sha256 => hash)
|
||||||
|
|
|
@ -43,14 +43,6 @@
|
||||||
(define read-elf
|
(define read-elf
|
||||||
(compose parse-elf get-bytevector-all))
|
(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")
|
(test-begin "debug-link")
|
||||||
|
|
||||||
|
|
|
@ -62,11 +62,6 @@
|
||||||
#:target target)
|
#:target target)
|
||||||
#:guile-for-build (%guile-for-build)))
|
#: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
|
(define %extension-package
|
||||||
;; Example of a package to use when testing 'with-extensions'.
|
;; Example of a package to use when testing 'with-extensions'.
|
||||||
(dummy-package "extension"
|
(dummy-package "extension"
|
||||||
|
|
|
@ -47,17 +47,6 @@
|
||||||
;; Globally disable grafts because they can trigger early builds.
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
(%graft? #f)
|
(%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.
|
;; Example manifest entries.
|
||||||
|
|
||||||
(define guile-1.8.8
|
(define guile-1.8.8
|
||||||
|
|
|
@ -30,14 +30,6 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-64))
|
#: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")
|
(test-begin "size")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue