diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-03-05 14:54:17 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-05 16:33:37 +0100 |
commit | c5a3d8f6469f9fb4d47e2d4c84980ab04aedb398 (patch) | |
tree | 14bd399663b802439a6167397bc79d932cfcac80 /build-aux | |
parent | dd1ee160be8ba4e211432c08e161c24901cd670e (diff) | |
download | patches-c5a3d8f6469f9fb4d47e2d4c84980ab04aedb398.tar patches-c5a3d8f6469f9fb4d47e2d4c84980ab04aedb398.tar.gz |
tests: "make check-system" includes the current commit ID, if any.
* 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'.
Diffstat (limited to 'build-aux')
-rw-r--r-- | build-aux/run-system-tests.scm | 31 |
1 files changed, 26 insertions, 5 deletions
diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index a4c019ab0b..b5403e0ece 100644 --- a/build-aux/run-system-tests.scm +++ b/build-aux/run-system-tests.scm @@ -29,6 +29,7 @@ #: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 @@ 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 @@ instance." ;; ;; 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 @@ instance." (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 @@ instance." #: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...~%" |