;;; 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
                             (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)
ef='/guix/commit/.mailmap?id=4b3ff36228da17db980c98fe9e1669be613a5402'>Update email for Brett Gilio.</a><span class='msg-avail'>...</span></td><td>Brett Gilio</td></tr>
<tr><td><span title='2019-12-18 22:57:44 -0600'>2019-12-18</span></td><td><a href='/guix/commit/.mailmap?id=a7cdf124c0b28be6c4e750161c1341753eede7b8'>gnu: leocad: Update to 19.07.1.</a><span class='msg-avail'>...</span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2019-05-03 08:45:55 +0200'>2019-05-03</span></td><td><a href='/guix/commit/.mailmap?id=3e85909044d8d9b492bcd2ecedde26d71794f145'>Correct email address for ison.</a><span class='msg-avail'>...</span></td><td>ison</td></tr>
<tr><td><span title='2019-03-18 15:05:08 +0100'>2019-03-18</span></td><td><a href='/guix/commit/.mailmap?id=47956fa0c24efcdcba3493f0231c30e9a39ec7df'>Correct name and email address for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2019-01-21 10:10:43 +0100'>2019-01-21</span></td><td><a href='/guix/commit/.mailmap?id=e3634bd0a3480bde3aba5bd6d84d7aff25413207'>Update .mailmap.</a><span class='msg-avail'>...</span></td><td>Mathieu Othacehe</td></tr>
<tr><td><span title='2018-08-27 14:46:26 +0200'>2018-08-27</span></td><td><a href='/guix/commit/.mailmap?id=4715f92ef0b9650cc4075c69f17aa51e84da3f21'>Update email for Pierre Neidhardt.</a><span class='msg-avail'>...</span></td><td>Pierre Neidhardt</td></tr>
<tr><td><span title='2018-07-16 17:14:39 +0200'>2018-07-16</span></td><td><a href='/guix/commit/.mailmap?id=8bbb79cf95a07a40950448a8a09d888254404ed4'>mailmap: Add a line for Pierre-Antoine.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-07-16 16:53:50 +0200'>2018-07-16</span></td><td><a href='/guix/commit/.mailmap?id=33f4d14ab17096984404fc404b4539d784ecbf32'>mailmap: Add another line for myself.</a><span class='msg-avail'>...</span></td><td>Nils Gillmann</td></tr>
<tr><td><span title='2018-03-20 17:17:58 +0100'>2018-03-20</span></td><td><a href='/guix/commit/.mailmap?id=4a78fd4617908546be15d2c101f5cab512c71f8e'>Correct name and Email for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2018-02-11 09:44:11 -0500'>2018-02-11</span></td><td><a href='/guix/commit/.mailmap?id=c275462025917ad7b8e182f29d6580804e585643'>mailmap: Adjust entries for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2017-11-26 18:21:19 -0500'>2017-11-26</span></td><td><a href='/guix/commit/.mailmap?id=9221979e367a95c14a35236742792fb624d8e47c'>Update e-mail for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>
<tr><td><span title='2017-10-03 17:07:54 +0200'>2017-10-03</span></td><td><a href='/guix/commit/.mailmap?id=d109b1e85c5c1438e66dfc05ea4a018418edaf19'>Update e-mail for Theodoros Foradis.</a><span class='msg-avail'>...</span></td><td>Theodoros Foradis</td></tr>
<tr><td><span title='2017-08-29 20:13:24 -0400'>2017-08-29</span></td><td><a href='/guix/commit/.mailmap?id=3c8ba11a97d3f3b671b8919da8c41f0b0e2ccaf3'>Update e-mail for Kei Kebreau.</a><span class='msg-avail'>...</span></td><td>Kei Kebreau</td></tr>
<tr><td><span title='2017-08-13 16:11:48 -0400'>2017-08-13</span></td><td><a href='/guix/commit/.mailmap?id=79d5ad20e87066a0937a4b61a4857de2b34a7a30'>mailmap: fix entries for ng0.</a><span class='msg-avail'>...</span></td><td>ng0</td></tr>