~ruther/ruthless-guix

ref: 5f690393fdc6883c3a756fbceeeeb00e1dd2c0a1 ruthless-guix/etc/manifests/system-tests.scm -rw-r--r-- 2.1 KiB
5f690393 — Rutherther feat: add system tests support 3 days ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

;;; This file has been taken from GNU Guix.
;;; The original copyright header follows.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2018-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;;
;;; 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 (ruther tests)
             (gnu tests)
             (gnu packages package-management)
             (guix monads)
             (guix store)
             ((guix git-download) #:select (git-predicate))
             ((guix utils) #:select (current-source-directory))
             (git)
             (srfi srfi-1)
             (ice-9 match))

(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* (filter-tests
          #:key
          (tests (ruther-system-tests))
          (filter-tests (getenv "TESTS")))
  (match filter-tests
    (#f
     tests)
    ((= string-tokenize (filter-tests ...))
     (filter (lambda (test)
               (member (system-test-name test) filter-tests))
             tests))))

(define (system-test-manifest)
  "Return a manifest containing all the system tests, or all those selected by
the 'TESTS' environment variable."
  (let* ((tests (filter-tests)))
    (format (current-error-port) "Selected ~a system tests...~%"
            (length tests))

    (manifest (map system-test->manifest-entry tests))))

;; Return the manifest.
(system-test-manifest)