;;; 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)
01</span></td><td><a href='/guix/commit/gnu/packages.scm?id=e30c2be10da8929e42aafc7770257e84de49ffbb'>packages: Remove support for PACKAGE-VERSION deprecated syntax.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-03-08 23:42:53 +0100'>2017-03-08</span></td><td><a href='/guix/commit/gnu/packages.scm?id=d75e8f36a80be8155f40678e30d8384c205cf96f'>packages: Use PACKAGE@VERSION syntax when reporting ambiguities.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-02-27 16:44:57 +0300'>2017-02-27</span></td><td><a href='/guix/commit/gnu/packages.scm?id=96eaa55ffb9877c319df09d158fca31034d8f0a2'>packages: Add 'search-auxiliary-file'.</a><span class='msg-avail'>...</span></td><td>Alex Kost</td></tr>
<tr><td><span title='2017-01-28 18:55:20 +0100'>2017-01-28</span></td><td><a href='/guix/commit/gnu/packages.scm?id=55b2d921456e888f097bf4e43a3d25b112f3e563'>Use 'mlambda' instead of 'memoize'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-01-28 18:55:20 +0100'>2017-01-28</span></td><td><a href='/guix/commit/gnu/packages.scm?id=f9704f179a5160013c4a401dce3761714bba8e72'>Add (guix memoization).</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-09-20 23:22:42 +0900'>2016-09-20</span></td><td><a href='/guix/commit/gnu/packages.scm?id=e465d9e19087ab150f7e31f21c09e4a147b93b36'>ui: Do not shadow '_' where it's used as a literal syntax match.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-09-06 23:22:10 +0200'>2016-09-06</span></td><td><a href='/guix/commit/gnu/packages.scm?id=01afdab89c6a91f4cd05d3c4f4ff95a0402703eb'>packages: Add 'package-superseded' and associated support.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-07-28 18:50:43 +0200'>2016-07-28</span></td><td><a href='/guix/commit/gnu/packages.scm?id=6980511b7391e65a307689f90e4ef5c1979e4541'>packages: Add 'hidden-package'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-06-20 23:50:46 +0200'>2016-06-20</span></td><td><a href='/guix/commit/gnu/packages.scm?id=2a6ba870867e31a32faca0dbf0e062bf9f5c0d78'>packages: Export 'scheme-modules'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-05-04 23:35:55 +0200'>2016-05-04</span></td><td><a href='/guix/commit/gnu/packages.scm?id=958dd3ce68733bcd5c1231424c7e4ad39e67594a'>utils: Move combinators to (guix combinators).</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2016-04-14 10:36:11 +0300'>2016-04-14</span></td><td><a href='/guix/commit/gnu/packages.scm?id=25897079a2ea66191b22e6d0c7411d3b3a29a642'>packages: Add 'search-patches'.</a><span class='msg-avail'>...</span></td><td>Alex Kost</td></tr>