Merge branch 'master' into ungrafting

3 files changed, 98 insertions, 75 deletions

diff --git a/tests/glob.scm b/tests/glob.scm
index 3134069789..2a5a40c3c6 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,7 +54,8 @@
  "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
  "foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
  "[123]x" => '((set #\1 #\2 #\3) "x")
- "[a-z]" => '((range #\a #\z)))
+ "[a-z]" => '((range #\a #\z))
+ "**/*.scm" => '(**/ * ".scm"))
 
 (test-glob-match
  ("foo" matches "foo" (and not "foobar" "barfoo"))
@@ -64,6 +66,8 @@
  ("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
   (and not "ab-c" "ab00c" "ab3"))
  ("ab[cdefg]" matches "abc" "abd" "abg"
-  (and not "abh" "abcd" "ab[")))
+  (and not "abh" "abcd" "ab["))
+ ("foo/**/*.scm" matches "foo/bar/baz.scm" "foo/bar.scm" "foo/bar/baz/zab.scm"
+  (and not "foo/bar/baz.java" "foo/bar.smc")))
 
 (test-end "glob")
diff --git a/tests/opam.scm b/tests/opam.scm
index ec2a668307..11984b56a6 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -80,38 +80,41 @@ url {
                 (set! test-source-hash
                   (call-with-input-file file-name port-sha256))))
              (_ (error "Unexpected URL: " url)))))
-      (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
-        (mkdir-p my-package)
-        (with-output-to-file (string-append my-package "/opam")
-          (lambda _
-            (format #t "~a" test-opam-file))))
-      (match (opam->guix-package "foo" #:repository test-repo)
-        (('package
-           ('name "ocaml-foo")
-           ('version "1.0.0")
-           ('source ('origin
-                      ('method 'url-fetch)
-                      ('uri "https://example.org/foo-1.0.0.tar.gz")
-                      ('sha256
-                       ('base32
-                        (? string? hash)))))
-           ('build-system 'ocaml-build-system)
-           ('propagated-inputs
-            ('quasiquote
-             (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
-           ('native-inputs
-            ('quasiquote
-             (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
-              ("ocamlbuild" ('unquote 'ocamlbuild)))))
-           ('home-page "https://example.org/")
-           ('synopsis "Some example package")
-           ('description "This package is just an example.")
-           ('license #f))
-         (string=? (bytevector->nix-base32-string
-                    test-source-hash)
-                   hash))
-        (x
-         (pk 'fail x #f)))))
+        (mock ((guix import opam) get-opam-repository
+               (const test-repo))
+              (let ((my-package (string-append test-repo
+                                               "/packages/foo/foo.1.0.0")))
+                (mkdir-p my-package)
+                (with-output-to-file (string-append my-package "/opam")
+                  (lambda _
+                    (format #t "~a" test-opam-file))))
+              (match (opam->guix-package "foo" #:repo test-repo)
+                (('package
+                   ('name "ocaml-foo")
+                   ('version "1.0.0")
+                   ('source ('origin
+                              ('method 'url-fetch)
+                              ('uri "https://example.org/foo-1.0.0.tar.gz")
+                              ('sha256
+                               ('base32
+                                (? string? hash)))))
+                   ('build-system 'ocaml-build-system)
+                   ('propagated-inputs
+                    ('quasiquote
+                     (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+                   ('native-inputs
+                    ('quasiquote
+                     (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+                      ("ocamlbuild" ('unquote 'ocamlbuild)))))
+                   ('home-page "https://example.org/")
+                   ('synopsis "Some example package")
+                   ('description "This package is just an example.")
+                   ('license #f))
+                 (string=? (bytevector->nix-base32-string
+                            test-source-hash)
+                           hash))
+                (x
+                 (pk 'fail x #f))))))
 
 ;; Test the opam file parser
 ;; We fold over some test cases. Each case is a pair of the string to parse and the
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6560612c40..b86ce09425 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -47,7 +47,8 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
   (test-equal name
     '(1 #t)
     (let ((error-output (open-output-string)))
-      (parameterize ((guix-warning-port error-output))
+      (parameterize ((current-error-port error-output)
+                     (guix-warning-port error-output))
         (catch 'quit
           (lambda ()
             exp
@@ -57,6 +58,14 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
                   (let ((message (get-output-string error-output)))
                     (->bool (string-match error-rx message))))))))))
 
+(define (request-substitution item destination)
+  "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
+  (parameterize ((guix-warning-port (current-error-port)))
+    (with-input-from-string (string-append "substitute " item " "
+                                           destination "\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
+
 (define %public-key
   ;; This key is known to be in the ACL by default.
   (call-with-input-file (string-append %config-directory "/signing-key.pub")
@@ -183,6 +192,11 @@ a file for NARINFO."
 ;; Transmit these options to 'guix substitute'.
 (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
 
+;; Never use file descriptor 4, unlike what happens when invoked by the
+;; daemon.
+(%error-to-file-descriptor-4? #f)
+
+
 (test-equal "query narinfo without signature"
   ""                                              ; not substitutable
 
@@ -283,10 +297,12 @@ System: mips64el-linux\n")
 (test-quit "substitute, no signature"
     "no valid substitute"
   (with-narinfo %narinfo
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, invalid hash"
     "no valid substitute"
@@ -294,10 +310,12 @@ System: mips64el-linux\n")
   (with-narinfo (string-append %narinfo "Signature: "
                                (signature-field "different body")
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, unauthorized key"
     "no valid substitute"
@@ -306,10 +324,12 @@ System: mips64el-linux\n")
                                 %narinfo
                                 #:public-key %wrong-public-key)
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-equal "substitute, authorized key"
   "Substitutable data."
@@ -318,10 +338,9 @@ System: mips64el-linux\n")
     (dynamic-wind
       (const #t)
       (lambda ()
-        (guix-substitute "--substitute"
-                         (string-append (%store-prefix)
-                                        "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                         "substitute-retrieved")
+        (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"))))))
@@ -351,10 +370,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (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")))))))
@@ -380,10 +398,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (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")))))))
@@ -416,10 +433,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (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")))))))
@@ -450,10 +466,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (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")))))))
@@ -469,10 +484,12 @@ System: mips64el-linux\n")
                                    #:public-key %wrong-public-key))
         %main-substitute-directory
 
-      (guix-substitute "--substitute"
-                       (string-append (%store-prefix)
-                                      "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                       "substitute-retrieved"))))
+      (with-input-from-string (string-append "substitute "
+                                             (%store-prefix)
+                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                             " substitute-retrieved\n")
+        (lambda ()
+          (guix-substitute "--substitute"))))))
 
 (test-equal "substitute, narinfo with several URLs"
   "Substitutable data."
@@ -512,10 +529,9 @@ System: mips64el-linux\n")))
           (parameterize ((substitute-urls
                           (list (string-append "file://"
                                                %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (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")))))))