Merge branch 'master' into gnome-team

7 files changed, 158 insertions, 32 deletions

diff --git a/tests/cpan.scm b/tests/cpan.scm
index e4ee788e9d..42e8c4e42c 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -102,21 +102,22 @@
                (downstream-name "perl-test-script")
                (type 'propagated))))
   (with-http-server `((200 ,test-json)
-                      (200 ,test-source)
-                      (200 "{ \"distribution\" : \"Test-Script\" }"))
-    (define source
-      (parameterize ((%metacpan-base-url (%local-url)))
+                      (200 "{ \"distribution\" : \"Test-Script\" }")
+                      (200 ,test-source))
+    (parameterize ((%metacpan-base-url (%local-url))
+                   (current-http-proxy (%local-url)))
+      (define source
         (package-latest-release
          (dummy-package "perl-test-script"
-                        (version "0.0.0")
-                        (source (dummy-origin
-                                 (method url-fetch)
-                                 (uri "mirror://cpan/Foo-Bar-0.0.0.tgz"))))
-         (list %cpan-updater))))
+           (version "0.0.0")
+           (source (dummy-origin
+                    (method url-fetch)
+                    (uri "mirror://cpan/Foo-Bar-0.0.0.tgz"))))
+         (list %cpan-updater)))
 
-    (list (upstream-source-urls source)
-          (upstream-source-signature-urls source)
-          (upstream-source-inputs source))))
+      (list (upstream-source-urls source)
+            (upstream-source-signature-urls source)
+            (upstream-source-inputs source)))))
 
 (test-equal "metacpan-url->mirror-url, http"
   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
diff --git a/tests/elpa.scm b/tests/elpa.scm
index f6d008cd09..f563b99df1 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -43,17 +43,17 @@
             [(11 88 6)
              nil "Integrated environment for *TeX*" tar
              ((:url . "http://www.gnu.org/software/auctex/"))])
-    (taxy-magit-section .
-		        [(0 12 2)
-		         ((emacs
-			   (26 3))
-		          (magit-section
-			   (3 2 1))
-		          (taxy
-			   (0 10)))
-		         "View Taxy structs in a Magit Section buffer" tar
-		         ((:url . "https://github.com/alphapapa/taxy.el")
-		          (:keywords "lisp"))])))
+    (fake-taxy-magit-section .
+		             [(0 12 2)
+		              ((emacs
+			        (26 3))
+		               (magit-section
+			        (3 2 1))
+		               (taxy
+			        (0 10)))
+		              "View Taxy structs in a Magit Section buffer" tar
+		              ((:url . "https://github.com/alphapapa/taxy.el")
+		               (:keywords "lisp"))])))
 
 
 (test-begin "elpa")
@@ -88,8 +88,8 @@
   (eval-test-with-elpa "auctex"))
 
 (test-equal "package-latest-release"
-  (list '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar")
-        '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar.sig")
+  (list '("http://elpa.gnu.org/packages/fake-taxy-magit-section-0.12.2.tar")
+        '("http://elpa.gnu.org/packages/fake-taxy-magit-section-0.12.2.tar.sig")
         (list (upstream-input
                (name "magit-section")
                (downstream-name "emacs-magit-section")
@@ -105,12 +105,13 @@
   (with-http-server `((200 ,(object->string elpa-mock-archive)))
     (parameterize ((current-http-proxy (%local-url)))
       (define source
+        ;; Note: Use 'http' URLs to the proxy is used.
         (package-latest-release
-         (dummy-package "emacs-taxy-magit-section"
+         (dummy-package "emacs-fake-taxy-magit-section"
                         (version "0.0.0")
                         (source (dummy-origin
                                  (method url-fetch)
-                                 (uri "https://elpa.gnu.org/xyz"))))
+                                 (uri "http://elpa.gnu.org/xyz"))))
          (list %elpa-updater)))
 
       (list (upstream-source-urls source)
diff --git a/tests/guix-locate.sh b/tests/guix-locate.sh
new file mode 100755
index 0000000000..43f8ba53b0
--- /dev/null
+++ b/tests/guix-locate.sh
@@ -0,0 +1,72 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2023 Antoine R. Dumont <antoine.romain.dumont@gmail.com>
+# 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 locate' command-line utility.
+#
+
+set -x
+
+RUN_EXPENSIVE_TESTS="${RUN_EXPENSIVE_TESTS:-false}"
+
+tmpdir="guix-index-$$"
+# In the following tests, we use two different databases, one for each
+# indexation method.
+tmpdb_manifests="$tmpdir/manifests/db.sqlite"
+tmpdb_store="$tmpdir/store/db.sqlite"
+trap 'rm -rf "$tmpdir" "$tmpdb_store" "$tmpdb_manifests"' EXIT
+
+guix locate --version
+
+# Preparing db locations for both indexation methods.
+mkdir -p "$(dirname "$tmpdb_manifests")" "$(dirname "$tmpdb_store")"
+
+cmd_manifests="guix locate --database=$tmpdb_manifests --method=manifests"
+cmd_store="guix locate --database=$tmpdb_store --method=store"
+
+# Lookup without any db should fail.
+guix locate --database="$tmpdb_manifests" guile && false
+guix locate --database="$tmpdb_store" guile && false
+
+# Lookup without anything in db should yield no results because the indexer
+# didn't stumble upon any profile.
+test -z "$(guix locate --database="$tmpdb_manifests" guile)"
+
+# Install a package.
+guix package --bootstrap --install guile-bootstrap \
+     --profile="$tmpdir/profile"
+
+# Look for 'guile'.
+$cmd_manifests --update
+$cmd_manifests guile | grep "$(guix build guile-bootstrap)/bin/guile"
+$cmd_manifests boot-9.scm | grep ^guile-bootstrap
+
+# Using a glob pattern.
+$cmd_manifests -g '*.scm' | grep "^guile-bootstrap.*boot-9"
+
+# Statistics.
+$cmd_manifests --stats
+
+if $RUN_EXPENSIVE_TESTS
+then
+    $cmd_store --update
+    $cmd_store guile
+    $cmd_store guile | grep "$(guix build guile-bootstrap)/bin/guile"
+    $cmd_store boot-9.scm | grep ^guile-bootstrap
+fi
diff --git a/tests/minetest.scm b/tests/minetest.scm
index cbb9e83889..78469bf95b 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -194,7 +194,7 @@
     (scm->json-port
      (list->vector (filter-map argument-list->json sorted-argument-lists))))
   (mock ((guix http-client) http-fetch
-         (lambda* (url #:key headers)
+         (lambda* (url #:key headers timeout)
            (unless (string-prefix? "mock://api/packages/" url)
              (error "the URL ~a should not be used" url))
            (define resource
diff --git a/tests/packages.scm b/tests/packages.scm
index 5e8eac99dc..2b7ab01f7d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -368,6 +368,23 @@
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(test-equal "package-transitive-supported-systems detects cycles"
+  '("c" "a" "b" "c")
+  (letrec* ((a (dummy-package "a"
+                 (build-system trivial-build-system)
+                 (native-inputs (list c))))
+            (b (dummy-package "b"
+                 (build-system trivial-build-system)
+                 (inputs (list a))))
+            (c (dummy-package "c"
+                 (build-system trivial-build-system)
+                 (inputs (list b)))))
+    (guard (c ((package-cyclic-dependency-error? c)
+               (map package-name
+                    (cons (package-error-package c)
+                          (package-error-dependency-cycle c)))))
+      (package-transitive-supported-systems c))))
+
 (test-assert "package-development-inputs"
   ;; Note: Due to propagated inputs, 'package-development-inputs' returns a
   ;; couple more inputs, such as 'linux-libre-headers'.
diff --git a/tests/store-roots.scm b/tests/store-roots.scm
index 5bcf1bc87e..9877987a65 100644
--- a/tests/store-roots.scm
+++ b/tests/store-roots.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,14 +21,26 @@
   #:use-module (guix store)
   #:use-module (guix store roots)
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module ((guix build utils) #:select (delete-file-recursively))
+  #:use-module ((guix config) #:select (%state-directory))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64))
 
-(define %store
-  (open-connection))
+(define %store #f)
 
 (test-begin "store-roots")
 
+(test-equal "gc-roots, initial"
+  (list (string-append %state-directory "/profiles"))
+  (begin
+    ;; 'gc-roots' should gracefully handle lack of that directory.
+    (delete-file-recursively (string-append %state-directory "/profiles"))
+    (gc-roots)))
+
+;; The 'open-connection' call below gets guix-daemon to create
+;; %STATE-DIRECTORY/profiles.
+(set! %store (open-connection))
+
 (test-assert "gc-roots, regular root"
   (let* ((item (add-text-to-store %store "something"
                                   (random-text)))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 8df3938b59..7246ed82d5 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014-2015, 2017-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2015, 2017-2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -639,6 +639,29 @@ System: mips64el-linux\n")))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
 
+(test-equal "substitute, previous partial download around"
+  "Substitutable data."
+  (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo))
+      %main-substitute-directory
+
+    (with-http-server `((200 ,(string-append %narinfo "Signature: "
+                                             (signature-field %narinfo)))
+                        (200 ,(call-with-input-file
+                                  (string-append %main-substitute-directory
+                                                 "/example.nar")
+                                get-bytevector-all)))
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (parameterize ((substitute-urls (list (%local-url))))
+            (mkdir-p "substitute-retrieved/a/b/c/d") ;add stale data
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
+          (call-with-input-file "substitute-retrieved" get-string-all))
+        (lambda ()
+          (false-if-exception (delete-file "substitute-retrieved")))))))
+
 (test-quit "substitute, narinfo is available but nar is missing"
     "failed to find alternative substitute"
   (with-narinfo*