diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-03-05 16:16:02 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-05 16:33:38 +0100 |
commit | 5ec4156bbcaec8337f78411204d59e59e706103b (patch) | |
tree | a4cac57c8a683f02216193ee0fbcabf16cb202b5 /etc/system-tests.scm | |
parent | c0b726c2112e0e670dc134583b376541c0a3789a (diff) | |
download | guix-5ec4156bbcaec8337f78411204d59e59e706103b.tar.gz |
tests: Add a manifest for system tests.
The manifest can be passed to 'guix build -m', 'guix weather -m', and so on. It can also be passed to an installed 'guix' (without ./pre-inst-env), with the exception so far of installation tests. * build-aux/run-system-tests.scm: Remove. Move interesting bits move to... * etc/system-tests.scm: ... here. New file. * Makefile.am (EXTRA_DIST): Remove 'build-aux/run-system-tests.scm' and add 'etc/system-tests.scm'. (check-system): Rewrite to run 'guix build -m etc/system-tests.scm'.
Diffstat (limited to 'etc/system-tests.scm')
-rw-r--r-- | etc/system-tests.scm | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/etc/system-tests.scm b/etc/system-tests.scm new file mode 100644 index 0000000000..ab2827e70a --- /dev/null +++ b/etc/system-tests.scm @@ -0,0 +1,94 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(use-modules (gnu tests) + (gnu packages package-management) + ((gnu ci) #:select (channel-source->package)) + ((guix git-download) #:select (git-predicate)) + ((guix utils) #:select (current-source-directory)) + (git) + (ice-9 match)) + +(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 + ;; 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)))))) + +(define (system-test->manifest-entry test) + "Return a manifest entry for TEST, a system test." + (manifest-entry + (name (string-append "test." (system-test-name test))) + (version "0") + (item test))) + +(define (system-test-manifest) + "Return a manifest containing all the system tests, or all those selected by +the 'TESTS' environment variable." + (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)) + + ;; Intern SOURCE so that 'build-from-source' in (guix channels) sees + ;; "fresh" file names and thus doesn't find itself loading .go files + ;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'. + (let* ((source (local-file source "guix-source" + #:recursive? #t + #:select? + (or (git-predicate source) + (const #t)))) + (tests (tests-for-current-guix source commit))) + (format (current-error-port) "Selected ~a system tests...~%" + (length tests)) + + (manifest (map system-test->manifest-entry tests)))) + +;; Return the manifest. +(system-test-manifest) |