all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
blob 221a63bb7f5ef32e93af530c03a17351599a98a1 3978 bytes (raw)
name: etc/system-tests.scm 	 # note: path name is non-authoritative(*)

  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
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2018-2020, 2022 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)
             (guix monads)
             (guix store)
             ((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
  (let ((guix (channel-source->package source #:commit commit)))
    (map (lambda (test)
           (system-test
            (inherit test)
            (value (mparameterize %store-monad ((current-guix-package guix))
                     (system-test-value test)))))
         (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
                             (if commit
                                 (string-append "guix-"
                                                (string-take commit 7))
                                 "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)

debug log:

solving 221a63bb7f ...
found 221a63bb7f in https://git.savannah.gnu.org/cgit/guix.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.