Toggle diff (246 lines)
diff --git a/Makefile.am b/Makefile.am
index 8b026b6da6..d9d23eec88 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2015, 2017 Alex Kost <alezost@gmail.com>
# Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
@@ -289,6 +289,7 @@ MODULES = \
guix/import/print.scm \
guix/import/pypi.scm \
guix/import/stackage.scm \
+ guix/import/test.scm \
guix/import/texlive.scm \
guix/import/utils.scm \
guix/scripts.scm \
@@ -595,6 +596,7 @@ SH_TESTS = \
tests/guix-authenticate.sh \
tests/guix-environment.sh \
tests/guix-environment-container.sh \
+ tests/guix-refresh.sh \
tests/guix-shell.sh \
tests/guix-shell-export-manifest.sh \
tests/guix-graph.sh \
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)))
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh
new file mode 100644
index 0000000000..de094a6c1d
--- /dev/null
+++ b/tests/guix-refresh.sh
@@ -0,0 +1,117 @@
+# 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/>.
+
+#
+# Test the 'guix refresh' command-line utility.
+#
+
+guix refresh --version
+
+manifest="t-guix-refresh-manifest-$$.scm"
+module_dir="t-guix-refresh-modules-$$"
+trap 'rm -f "$manifest"; rm -rf "$module_dir"' EXIT
+
+# Tell the 'test' updater what to simulate.
+export GUIX_TEST_UPDATER_TARGETS
+idutils_version="$(guix package -A ^idutils$ | cut -f2)"
+GUIX_TEST_UPDATER_TARGETS='
+ (("guile" "3" (("12.5" "file:///dev/null")
+ ("1.6.4" "file:///dev/null")))
+ ("libreoffice" "" (("1.0" "file:///dev/null")))
+ ("idutils" "" (("'$idutils_version'" "file:///dev/null")))
+ ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"))))'
+
+# No newer version available.
+! guix refresh -t test idutils
+case "$(guix refresh -t test idutils 2>&1)" in
+ *"$idutils_version"*"already the latest version"*) true;;
+ *) false;;
+esac
+! guix refresh -t test libreoffice
+case "$(guix refresh -t test libreoffice 2>&1)" in
+ *"greater than the latest known version"*"1.0"*) true;;
+ *) false;;
+esac
+
+# Various ways to specify packages.
+cat > "$manifest" <<EOF
+(specifications->manifest (list "guile@3.0"))
+EOF
+default_IFS="$IFS"
+IFS=X
+for spec in "guile" \
+ "guile@3.0" \
+ "-eX(@ (gnu packages guile) guile-3.0)" \
+ "-mX$manifest" \
+ "guileX-r" \
+ "-sXcore"
+do
+ guix refresh -t test $spec
+ case "$(guix refresh -t test $spec 2>&1)" in
+ *"would be upgraded"*"12.5"*)
+ true;;
+ *)
+ false;;
+ esac
+done
+IFS="$default_IFS"
+
+# Actually updating.
+mkdir "$module_dir"
+echo hello > "$module_dir/source"
+cat > "$module_dir/sample.scm"<<EOF
+(define-module (sample)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (gnu packages base))
+
+(define-public my-thing
+ (package
+ (inherit hello)
+ (name "the-test-package")
+ (version "4.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/hello/hello-" version
+ ".tar.gz"))
+ (sha256
+ (base32
+ "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))))
+EOF
+guix refresh -t test -L "$module_dir" the-test-package
+guix refresh -t test -L "$module_dir" the-test-package -u
+grep 'version "5.5"' "$module_dir/sample.scm"
+grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm"
+
+# Specifying a target version.
+! guix refresh -t test guile=2.0.0
+case "$(guix refresh -t test guile=2.0.0 2>&1)" in
+ *"failed to find"*"2.0.0"*) true;;
+ *) false;;
+esac
+for spec in "guile=1.6.4" "guile@3=1.6.4"
+do
+ guix refresh -t test "$spec"
+ case "$(guix refresh -t test "$spec" 2>&1)" in
+ *"would be downgraded"*"1.6.4"*) true;;
+ *) false;;
+ esac
+done
+
+# Listing updaters. This should work whether or not networking is available.
+guix refresh --list-updaters
--
2.38.1
