ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: System tests really parameterize 'current-guix-package'.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2022-04-10 23:43:08 +02:00
parent 435e1cef00
commit dbde386794
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
etc/system-tests.scm
View file

@ -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 @@ (define (source-commit directory)
(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 @@ (define (tests-for-current-guix source commit)
;; 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."