summaryrefslogtreecommitdiff
path: root/etc/system-tests.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-05 16:16:02 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-05 16:33:38 +0100
commit5ec4156bbcaec8337f78411204d59e59e706103b (patch)
treea4cac57c8a683f02216193ee0fbcabf16cb202b5 /etc/system-tests.scm
parentc0b726c2112e0e670dc134583b376541c0a3789a (diff)
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.scm94
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)