Subject: [PATCH 4/4] refresh: Add CLI tests.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 3 Jan 2023 18:03:19 +0100

* guix/import/test.scm, tests/guix-refresh.sh: New files.
* Makefile.am (MODULES, SH_TESTS): Add them.
---
 Makefile.am           |   4 +-
 guix/import/test.scm  |  88 +++++++++++++++++++++++++++++++
 tests/guix-refresh.sh | 117 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 208 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/test.scm
 create mode 100644 tests/guix-refresh.sh

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 <[email-masked]>
+# Copyright © 2012-2023 Ludovic Courtès <[email-masked]>
 # Copyright © 2013 Andreas Enge <[email-masked]>
 # Copyright © 2015, 2017 Alex Kost <[email-masked]>
 # Copyright © 2016, 2018 Mathieu Lirzin <[email-masked]>
@@ -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 <[email-masked]>
+;;;
+;;; 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 <[email-masked]>
+#
+# 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 "[email-masked]"))
+EOF
+default_IFS="$IFS"
+IFS=X
+for spec in "guile"					\
+	    "[email-masked]"					\
+	    "-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