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 @@ (define-module (guix tests)
#: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 @@ (define-module (guix tests)
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 @@ (define-syntax-rule (mock (module proc replacement) body ...)
(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.

View file

@ -31,17 +31,9 @@ (define-module (test-challenge)
#: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)

View file

@ -43,14 +43,6 @@ (define %guile-executable
(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")

View file

@ -62,11 +62,6 @@ (define* (gexp->sexp* exp #:optional target)
#: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"

View file

@ -47,17 +47,6 @@ (define %store
;; 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

View file

@ -30,14 +30,6 @@ (define-module (test-size)
#: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")