Merge remote-tracking branch 'upstream/master' into staging

3 files changed, 128 insertions, 70 deletions

diff --git a/tests/go.scm b/tests/go.scm
index 6ab99f508a..e5780e68b0 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -19,7 +19,7 @@
 ;;; Summary
 ;; Tests for guix/import/go.scm
 
-(define-module (test-import-go)
+(define-module (tests-import-go)
   #:use-module (guix base32)
   #:use-module (guix build-system go)
   #:use-module (guix import go)
@@ -147,7 +147,8 @@ require github.com/kr/pretty v0.2.1
       ("https://pkg.go.dev/github.com/go-check/check"
        . ,pkg.go.dev)
       ("https://pkg.go.dev/github.com/go-check/check?tab=licenses"
-       . ,pkg.go.dev-licence))))
+       . ,pkg.go.dev-licence)
+      ("https://proxy.golang.org/github.com/go-check/check/@v/list" . ""))))
 
 (test-begin "go")
 
@@ -169,6 +170,12 @@ require github.com/kr/pretty v0.2.1
   "daa7c04131f5"
   (go-version->git-ref "v1.2.4-0.20191109021931-daa7c04131f5"))
 
+(test-assert "go-pseudo-version? multi-digit version number"
+  (go-pseudo-version? "v1.23.1-0.20200526195155-81db48ad09cc"))
+
+(test-assert "go-pseudo-version? semantic version with rc"
+  (go-pseudo-version? "v1.4.0-rc.4.0.20200313231945-b860323f09d0"))
+
 ;;; Unit tests for (guix import go)
 
 (test-equal "go-path-escape"
@@ -180,46 +187,43 @@ require github.com/kr/pretty v0.2.1
 (define (testing-parse-mod name expected input)
   (define (inf? p1 p2)
     (string<? (car p1) (car p2)))
-  (let ((input-port (open-input-string input)))
-    (test-equal name
-      (sort expected inf?)
-      (sort
-       ( (@@ (guix import go) parse-go.mod)
-         input-port)
-       inf?))))
+  (test-equal name
+    (sort expected inf?)
+    (sort ((@@ (guix import go) parse-go.mod) input) inf?)))
 
 (testing-parse-mod "parse-go.mod-simple"
-                   '(("good/thing" . "v1.4.5")
-                     ("new/thing/v2" . "v2.3.4")
-                     ("other/thing" . "v1.0.2"))
+                   '(("good/thing" "v1.4.5")
+                     ("new/thing/v2" "v2.3.4")
+                     ("other/thing" "v1.0.2"))
                    fixture-go-mod-simple)
 
 (testing-parse-mod "parse-go.mod-with-block"
-                   '(("A" . "v1")
-                     ("B" . "v1.0.0")
-                     ("C" . "v1.0.0")
-                     ("D" . "v1.2.3")
-                     ("E" . "dev"))
+                   '(("A" "v1")
+                     ("B" "v1.0.0")
+                     ("C" "v1.0.0")
+                     ("D" "v1.2.3")
+                     ("E" "dev"))
                    fixture-go-mod-with-block)
 
-(testing-parse-mod "parse-go.mod-complete"
-                   '(("github.com/corp/arbitrary-repo" . "v0.0.2")
-                     ("quoted.example.com/abitrary/repo" . "v0.0.2")
-                     ("one.example.com/abitrary/repo" . "v1.1.111")
-                     ("hub.jazz.net/git/user/project/sub/directory" . "v1.1.19")
-                     ("hub.jazz.net/git/user/project" . "v1.1.18")
-                     ("launchpad.net/~user/project/branch/sub/directory" . "v1.1.17")
-                     ("launchpad.net/~user/project/branch" . "v1.1.16")
-                     ("launchpad.net/project/series/sub/directory" . "v1.1.15")
-                     ("launchpad.net/project/series" . "v1.1.14")
-                     ("launchpad.net/project" . "v1.1.13")
-                     ("bitbucket.org/user/project/sub/directory" . "v1.11.21")
-                     ("bitbucket.org/user/project" . "v1.11.20")
-                     ("k8s.io/kubernetes/subproject" . "v1.1.101")
-                     ("github.com/user/project/sub/directory" . "v1.1.12")
-                     ("github.com/user/project" . "v1.1.11")
-                     ("github.com/go-check/check" . "v0.0.0-20140225173054-eb6ee6f84d0a"))
-                   fixture-go-mod-complete)
+(testing-parse-mod
+ "parse-go.mod-complete"
+ '(("github.com/corp/arbitrary-repo" "v0.0.2")
+   ("quoted.example.com/abitrary/repo" "v0.0.2")
+   ("one.example.com/abitrary/repo" "v1.1.111")
+   ("hub.jazz.net/git/user/project/sub/directory" "v1.1.19")
+   ("hub.jazz.net/git/user/project" "v1.1.18")
+   ("launchpad.net/~user/project/branch/sub/directory" "v1.1.17")
+   ("launchpad.net/~user/project/branch" "v1.1.16")
+   ("launchpad.net/project/series/sub/directory" "v1.1.15")
+   ("launchpad.net/project/series" "v1.1.14")
+   ("launchpad.net/project" "v1.1.13")
+   ("bitbucket.org/user/project/sub/directory" "v1.11.21")
+   ("bitbucket.org/user/project" "v1.11.20")
+   ("k8s.io/kubernetes/subproject" "v1.1.101")
+   ("github.com/user/project/sub/directory" "v1.1.12")
+   ("github.com/user/project" "v1.1.11")
+   ("github.com/go-check/check" "v0.0.0-20140225173054-eb6ee6f84d0a"))
+ fixture-go-mod-complete)
 
 ;;; End-to-end tests for (guix import go)
 (define (mock-http-fetch testcase)
@@ -249,44 +253,43 @@ require github.com/kr/pretty v0.2.1
 
 (test-equal "go-module->guix-package"
   '(package
-    (name "go-github-com-go-check-check")
-    (version "0.0.0-20201130134442-10cb98267c6c")
-    (source
-     (origin
-       (method git-fetch)
-       (uri (git-reference
-             (url "https://github.com/go-check/check.git")
-             (commit (go-version->git-ref version))))
-       (file-name (git-file-name name version))
-       (sha256
-        (base32
-         "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
-    (build-system go-build-system)
-    (arguments
-     (quote (#:import-path "github.com/go-check/check")))
-    (inputs
-     (quasiquote (("go-github-com-kr-pretty"
-                   (unquote go-github-com-kr-pretty)))))
-    (home-page "https://github.com/go-check/check")
-    (synopsis "Instructions")
-    (description #f)
-    (license license:bsd-2))
+     (name "go-github-com-go-check-check")
+     (version "0.0.0-20201130134442-10cb98267c6c")
+     (source
+      (origin
+        (method git-fetch)
+        (uri (git-reference
+              (url "https://github.com/go-check/check")
+              (commit (go-version->git-ref version))))
+        (file-name (git-file-name name version))
+        (sha256
+         (base32
+          "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
+     (build-system go-build-system)
+     (arguments
+      '(#:import-path "github.com/go-check/check"))
+     (propagated-inputs
+      `(("go-github-com-kr-pretty" ,go-github-com-kr-pretty)))
+     (home-page "https://github.com/go-check/check")
+     (synopsis "Instructions")
+     (description "Package check is a rich testing extension for Go's testing \
+package.")
+     (license license:bsd-2))
 
   ;; Replace network resources with sample data.
   (call-with-temporary-directory
    (lambda (checkout)
      (mock ((web client) http-get
             (mock-http-get fixtures-go-check-test))
-           (mock ((guix http-client) http-fetch
-                  (mock-http-fetch fixtures-go-check-test))
-                 (mock ((guix git) update-cached-checkout
-                        (lambda* (url #:key ref)
-                          ;; Return an empty directory and its hash.
-                          (values checkout
-                                  (nix-base32-string->bytevector
-                                   "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
-                                  #f)))
-                       (go-module->guix-package "github.com/go-check/check")))))))
+         (mock ((guix http-client) http-fetch
+                (mock-http-fetch fixtures-go-check-test))
+             (mock ((guix git) update-cached-checkout
+                    (lambda* (url #:key ref)
+                      ;; Return an empty directory and its hash.
+                      (values checkout
+                              (nix-base32-string->bytevector
+                               "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
+                              #f)))
+                 (go-module->guix-package "github.com/go-check/check")))))))
 
 (test-end "go")
-
diff --git a/tests/ipfs.scm b/tests/ipfs.scm
new file mode 100644
index 0000000000..3b662b22bd
--- /dev/null
+++ b/tests/ipfs.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 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 (test-ipfs)
+  #:use-module (guix ipfs)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module (guix tests)
+  #:use-module (web uri)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix ipfs) module.
+
+(define (ipfs-gateway-running?)
+  "Return true if the IPFS gateway is running at %IPFS-BASE-URL."
+  (let* ((uri    (string->uri (%ipfs-base-url)))
+         (socket (socket AF_INET SOCK_STREAM 0)))
+    (define connected?
+      (catch 'system-error
+        (lambda ()
+          (format (current-error-port)
+                  "probing IPFS gateway at localhost:~a...~%"
+                  (uri-port uri))
+          (connect socket AF_INET INADDR_LOOPBACK (uri-port uri))
+          #t)
+        (const #f)))
+
+    (close-port socket)
+    connected?))
+
+(unless (ipfs-gateway-running?)
+  (test-skip 1))
+
+(test-assert "add-file-tree + restore-file-tree"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let* ((source  (dirname (search-path %load-path "guix/base32.scm")))
+            (target  (string-append directory "/r"))
+            (content (pk 'content (add-file-tree source))))
+       (restore-file-tree (content-name content) target)
+       (file=? source target)))))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 697abc4684..21b513e1d8 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, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -198,7 +198,7 @@ a file for NARINFO."
 
 ;; Never use file descriptor 4, unlike what happens when invoked by the
 ;; daemon.
-(%error-to-file-descriptor-4? #f)
+(%reply-file-descriptor #f)
 
 
 (test-equal "query narinfo without signature"