1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (use-modules (gnu tests)
20 (gnu packages package-management)
21 ((gnu ci) #:select (channel-source->package))
22 ((guix git-download) #:select (git-predicate))
23 ((guix utils) #:select (current-source-directory))
27 (define (source-commit directory)
28 "Return the commit of the head of DIRECTORY or #f if it could not be
30 (let ((repository #f))
33 (set! repository (repository-open directory))
34 (let* ((head (repository-head repository))
35 (target (reference-target head))
36 (commit (oid->string target)))
37 (repository-close! repository)
41 (repository-close! repository))
44 (define (tests-for-current-guix source commit)
45 "Return a list of tests for perform, using Guix built from SOURCE, a channel
47 ;; Honor the 'TESTS' environment variable so that one can select a subset
48 ;; of tests to run in the usual way:
50 ;; make check-system TESTS=installed-os
51 (parameterize ((current-guix-package
52 (channel-source->package source #:commit commit)))
53 (match (getenv "TESTS")
56 ((= string-tokenize (tests ...))
57 (filter (lambda (test)
58 (member (system-test-name test) tests))
59 (all-system-tests))))))
61 (define (system-test->manifest-entry test)
62 "Return a manifest entry for TEST, a system test."
64 (name (string-append "test." (system-test-name test)))
68 (define (system-test-manifest)
69 "Return a manifest containing all the system tests, or all those selected by
70 the 'TESTS' environment variable."
72 (string-append (current-source-directory) "/.."))
75 ;; Fetch the current commit ID so we can potentially build the same
76 ;; derivation as ci.guix.gnu.org.
77 (source-commit source))
79 ;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
80 ;; "fresh" file names and thus doesn't find itself loading .go files
81 ;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
82 (let* ((source (local-file source
84 (string-append "guix-"
85 (string-take commit 7))
89 (or (git-predicate source)
91 (tests (tests-for-current-guix source commit)))
92 (format (current-error-port) "Selected ~a system tests...~%"
95 (manifest (map system-test->manifest-entry tests))))
97 ;; Return the manifest.
98 (system-test-manifest)