summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-01-03 16:54:32 +0100
committerLudovic Courtès <ludo@gnu.org>2023-01-08 16:11:45 +0100
commit04f247be81dcb5296ecab776f735bb615a1039d3 (patch)
treefaa708fcf92f77f296bd30c9e085fca58dbc2420 /guix/import
parent2e9c0e1ff6a87f1266ee50049c2d9c7bd736d131 (diff)
refresh: Add CLI tests.
* guix/import/test.scm, tests/guix-refresh.sh: New files. * Makefile.am (MODULES, SH_TESTS): Add them.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/test.scm88
1 files changed, 88 insertions, 0 deletions
diff --git a/guix/import/test.scm b/guix/import/test.scm
new file mode 100644
index 0000000000..767dcd5b61
--- /dev/null
+++ b/guix/import/test.scm
@@ -0,0 +1,88 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 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/>.
+
+(define-module (guix import test)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (web uri)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module ((guix utils) #:select (version-prefix?))
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 match)
+ #:export (%test-updater))
+
+;;; Commentary:
+;;;
+;;; This module defines a pseudo updater whose sole purpose is to allow
+;;; testing of the whole 'guix refresh' command.
+;;;
+;;; Code:
+
+(define test-target-version
+ ;; VHash that maps package names to version/URL tuples.
+ (make-parameter
+ (or (and=> (getenv "GUIX_TEST_UPDATER_TARGETS")
+ (lambda (str)
+ (alist->vhash (call-with-input-string str read))))
+ vlist-null)))
+
+(define (available-updates package)
+ "Return the list of available <upstream-source> records for PACKAGE."
+ (vhash-fold* (lambda (version+updates result)
+ (match version+updates
+ ((version (updates ...))
+ (if (version-prefix? version
+ (package-version package))
+ (append (map (match-lambda
+ ((version url)
+ (upstream-source
+ (package (package-name package))
+ (version version)
+ (urls (list url)))))
+ updates)
+ result)
+ result))))
+ '()
+ (package-name package)
+ (test-target-version)))
+
+(define (test-package? package)
+ "Return true if PACKAGE has pseudo updates available."
+ (and (not (vlist-null? (test-target-version))) ;cheap test
+ (pair? (available-updates package))))
+
+(define* (import-release package #:key (version #f))
+ "Return the <upstream-source> record denoting either the latest version of
+PACKAGE or VERSION."
+ (match (available-updates package)
+ (() #f)
+ ((sources ...)
+ (if version
+ (find (lambda (source)
+ (string=? (upstream-source-version source)
+ version))
+ sources)
+ (first sources)))))
+
+(define %test-updater
+ (upstream-updater
+ (name 'test)
+ (description "Pseudo updater for testing purposes.")
+ (pred test-package?)
+ (import import-release)))