mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
6 changed files with 25 additions and 40 deletions
|
@ -27,6 +27,7 @@ (define-module (guix tests)
|
|||
#: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 @@ (define-module (guix tests)
|
|||
shebang-too-long?
|
||||
mock
|
||||
%test-substitute-urls
|
||||
test-assertm
|
||||
test-equalm
|
||||
%substitute-directory
|
||||
with-derivation-narinfo
|
||||
with-derivation-substitute
|
||||
|
@ -161,6 +164,28 @@ (define-syntax-rule (mock (module proc replacement) body ...)
|
|||
(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.
|
||||
|
|
|
@ -31,17 +31,9 @@ (define-module (test-challenge)
|
|||
#: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)
|
||||
|
|
|
@ -43,14 +43,6 @@ (define %guile-executable
|
|||
(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")
|
||||
|
||||
|
|
|
@ -62,11 +62,6 @@ (define* (gexp->sexp* exp #:optional target)
|
|||
#: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"
|
||||
|
|
|
@ -47,17 +47,6 @@ (define %store
|
|||
;; 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
|
||||
|
|
|
@ -30,14 +30,6 @@ (define-module (test-size)
|
|||
#: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")
|
||||
|
||||
|
|
Loading…
Reference in a new issue