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

tests: "make check-system" includes the current commit ID, if any.

Browse source 
* build-aux/run-system-tests.scm (source-commit): New procedure.
(tests-for-current-guix): Add 'commit' parameter and pass it to
'channel-source->package'.
(run-system-tests): Call 'source-commit' and pass the result to
'tests-for-current-guix'.
This commit is contained in:
Ludovic Courtès 2020-03-05 14:54:17 +01:00
parent dd1ee160be
commit c5a3d8f646
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
build-aux/run-system-tests.scm
View file

@ -29,6 +29,7 @@ (define-module (run-system-tests)
#:use-module ((guix git-download) #:select (git-predicate))
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (git)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (ice-9 match)
@ -52,7 +53,24 @@ (define (filterm mproc lst) ;XXX: move to (guix monads)
lst)
(lift1 reverse %store-monad))))
(define (tests-for-current-guix source)
(define (source-commit directory)
"Return the commit of the head of DIRECTORY or #f if it could not be
determined."
(let ((repository #f))
(catch 'git-error
(lambda ()
(set! repository (repository-open directory))
(let* ((head (repository-head repository))
(target (reference-target head))
(commit (oid->string target)))
(repository-close! repository)
commit))
(lambda _
(when repository
(repository-close! repository))
#f))))
(define (tests-for-current-guix source commit)
"Return a list of tests for perform, using Guix built from SOURCE, a channel
instance."
;; Honor the 'TESTS' environment variable so that one can select a subset
@ -60,7 +78,7 @@ (define (tests-for-current-guix source)
;;
;; make check-system TESTS=installed-os
(parameterize ((current-guix-package
(channel-source->package source)))
(channel-source->package source #:commit commit)))
(match (getenv "TESTS")
(#f
(all-system-tests))
@ -69,12 +87,15 @@ (define (tests-for-current-guix source)
(member (system-test-name test) tests))
(all-system-tests))))))
(define (run-system-tests . args)
(define source
(string-append (current-source-directory) "/.."))
(define commit
;; Fetch the current commit ID so we can potentially build the same
;; derivation as ci.guix.gnu.org.
(source-commit source))
(with-store store
(with-status-verbosity 2
(run-with-store store
@ -86,7 +107,7 @@ (define source
#:select?
(or (git-predicate source)
(const #t))))
(tests -> (tests-for-current-guix source))
(tests -> (tests-for-current-guix source commit))
(drv (mapm %store-monad system-test-value tests))
(out -> (map derivation->output-path drv)))
(format (current-error-port) "Running ~a system tests...~%"