summaryrefslogtreecommitdiff
path: root/etc/system-tests.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-04-10 23:43:08 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-11 00:25:33 +0200
commitdbde386794cb5f4773b94a20ef585ca0f881544a (patch)
tree61bdf42f9053876d9ef2d2d42fc1ff938815b65f /etc/system-tests.scm
parent435e1cef0025fbe6cbb71b472218e8d132d1681c (diff)
tests: System tests really parameterize 'current-guix-package'.
Until now, 'current-guix-package' was parameterized in the wrong context. Thus, 'current-guix' would end up building a variant of the 'guix' package instead of the package returned by 'channel-source->package', which is much less expensive to build. * etc/system-tests.scm (mparameterize): New macro. (tests-for-current-guix): Change the 'value' field of each <system-test> record to parameterize 'current-guix-package' for good.
Diffstat (limited to 'etc/system-tests.scm')
-rw-r--r--etc/system-tests.scm39
1 files changed, 30 insertions, 9 deletions
diff --git a/etc/system-tests.scm b/etc/system-tests.scm
index 1085deed24..de6f592dee 100644
--- a/etc/system-tests.scm
+++ b/etc/system-tests.scm
@@ -18,6 +18,8 @@
(use-modules (gnu tests)
(gnu packages package-management)
+ (guix monads)
+ (guix store)
((gnu ci) #:select (channel-source->package))
((guix git-download) #:select (git-predicate))
((guix utils) #:select (current-source-directory))
@@ -41,6 +43,21 @@ determined."
(repository-close! repository))
#f))))
+(define-syntax mparameterize
+ (syntax-rules ()
+ "This form implements dynamic scoping, similar to 'parameterize', but in a
+monadic context."
+ ((_ monad ((parameter value) rest ...) body ...)
+ (let ((old-value (parameter)))
+ (mbegin monad
+ ;; XXX: Non-local exits are not correctly handled.
+ (return (parameter value))
+ (mlet monad ((result (mparameterize monad (rest ...) body ...)))
+ (parameter old-value)
+ (return result)))))
+ ((_ monad () body ...)
+ (mbegin monad body ...))))
+
(define (tests-for-current-guix source commit)
"Return a list of tests for perform, using Guix built from SOURCE, a channel
instance."
@@ -48,15 +65,19 @@ instance."
;; of tests to run in the usual way:
;;
;; make check-system TESTS=installed-os
- (parameterize ((current-guix-package
- (channel-source->package source #:commit commit)))
- (match (getenv "TESTS")
- (#f
- (all-system-tests))
- ((= string-tokenize (tests ...))
- (filter (lambda (test)
- (member (system-test-name test) tests))
- (all-system-tests))))))
+ (let ((guix (channel-source->package source #:commit commit)))
+ (map (lambda (test)
+ (system-test
+ (inherit test)
+ (value (mparameterize %store-monad ((current-guix-package guix))
+ (system-test-value test)))))
+ (match (getenv "TESTS")
+ (#f
+ (all-system-tests))
+ ((= string-tokenize (tests ...))
+ (filter (lambda (test)
+ (member (system-test-name test) tests))
+ (all-system-tests)))))))
(define (system-test->manifest-entry test)
"Return a manifest entry for TEST, a system test."