Merge branch 'master' into core-updates

16 files changed, 252 insertions, 46 deletions

diff --git a/tests/challenge.scm b/tests/challenge.scm
index 9c6d6e0d58..fdd5fd238e 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -27,8 +27,8 @@
   #:use-module (guix packages)
   #:use-module (guix gexp)
   #:use-module (guix base32)
+  #:use-module (guix narinfo)
   #:use-module (guix scripts challenge)
-  #:use-module (guix scripts substitute)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (gnu packages bootstrap)
   #:use-module (srfi srfi-1)
diff --git a/tests/crate.scm b/tests/crate.scm
index bb7032c344..b6c3a7ee2e 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -148,7 +148,7 @@
        \"crate_id\": \"intermediate-b\",
        \"kind\": \"normal\",
        \"req\": \"^1.0.0\"
-     }
+     },
      {
        \"crate_id\": \"leaf-alice\",
        \"kind\": \"normal\",
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index f8be48f0c0..afadcbe195 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015, 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -121,6 +121,12 @@ guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
 test `readlink "$gcroot"` = "$expected"
 rm "$gcroot"
 
+# Try '-r' with a relative file name.
+(cd "$tmpdir"; mkdir "gc-root";
+ guix environment --bootstrap -r "gc-root/r" --ad-hoc guile-bootstrap \
+      -- guile -c 1;
+ rm "gc-root/r"; rmdir "gc-root")
+
 # Same with an absolute file name.
 guix environment --bootstrap -r "$PWD/$gcroot" --ad-hoc guile-bootstrap \
      -- guile -c 1
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 3e5fa71d20..7eaad6823f 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
@@ -395,6 +395,14 @@ EOF
 guix package --bootstrap -m "$module_dir/manifest.scm"
 guix package -I | grep guile
 test `guix package -I | wc -l` -eq 1
+
+# Export a manifest, instantiate it, and make sure we get the same profile.
+profile_directory="$(readlink -f "$default_profile")"
+guix package --export-manifest > "$tmpfile"
+guix package --rollback --bootstrap
+guix package --bootstrap -m "$tmpfile"
+test "$(readlink -f "$default_profile")" = "$profile_directory"
+
 guix package --rollback --bootstrap
 
 # Applying two manifests.
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index f14c92ca75..24cc2591d5 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 #
@@ -204,7 +204,8 @@ cat > "$tmpfile" <<EOF
       (shepherd-service
         (provision '(buggy!))
         (requirement '(does-not-exist))
-        (start #t)))))
+        (start #t)))
+    (description "Buggy.")))
 
 (operating-system
   $OS_BASE
@@ -261,10 +262,14 @@ guix system vm "$tmpfile" -d | grep '\.drv$'
 drv1="`guix system vm "$tmpfile" -d`"
 drv2="`guix system vm "$tmpfile" -d`"
 test "$drv1" = "$drv2"
-drv1="`guix system disk-image -t iso9660 "$tmpfile" -d`"
-drv2="`guix system disk-image -t iso9660 "$tmpfile" -d`"
+drv1="`guix system image -t iso9660 "$tmpfile" -d`"
+drv2="`guix system image -t iso9660 "$tmpfile" -d`"
 test "$drv1" = "$drv2"
 
+# Check whether the graph commands work as expected.
+guix system extension-graph "$tmpfile" | grep 'label = "file-systems"'
+guix system shepherd-graph "$tmpfile" | grep 'label = "guix-daemon"'
+
 make_user_config "group-that-does-not-exist" "users"
 if guix system build "$tmpfile" -n 2> "$errorfile"
 then false
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 5fddb1fd13..7c3d730d0c 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,6 +75,18 @@
       (inferior-eval '(throw 'a 'b 'c 'd) inferior)
       'badness)))
 
+(test-equal "&inferior-exception, legacy mode"
+  '(a b c d)
+  ;; Omit #:command to open an inferior in "legacy" mode, where Guile runs
+  ;; directly.
+  (let ((inferior (open-inferior %top-builddir)))
+    (guard (c ((inferior-exception? c)
+               (close-inferior inferior)
+               (and (eq? inferior (inferior-exception-inferior c))
+                    (inferior-exception-arguments c))))
+      (inferior-eval '(throw 'a 'b 'c 'd) inferior)
+      'badness)))
+
 (test-equal "inferior-packages"
   (take (sort (fold-packages (lambda (package lst)
                                (cons (list (package-name package)
@@ -213,6 +225,26 @@
                                                       "uh uh")))
       #f)))
 
+(test-equal "inferior-eval-with-store, exception"
+  '(the-answer = 42)
+  (let ((inferior (open-inferior %top-builddir
+                                 #:command "scripts/guix")))
+    (guard (c ((inferior-exception? c)
+               (close-inferior inferior)
+               (inferior-exception-arguments c)))
+      (inferior-eval-with-store inferior %store
+                                '(lambda (store)
+                                   (throw 'the-answer '= 42))))))
+
+(test-equal "inferior-eval-with-store, not a procedure"
+  'wrong-type-arg
+  (let ((inferior (open-inferior %top-builddir
+                                 #:command "scripts/guix")))
+    (guard (c ((inferior-exception? c)
+               (close-inferior inferior)
+               (car (inferior-exception-arguments c))))
+     (inferior-eval-with-store inferior %store '(+ 1 2)))))
+
 (test-equal "inferior-package-derivation"
   (map derivation-file-name
        (list (package-derivation %store %bootstrap-guile "x86_64-linux")
diff --git a/tests/networking.scm b/tests/networking.scm
index c494a48067..f2421370d2 100644
--- a/tests/networking.scm
+++ b/tests/networking.scm
@@ -68,8 +68,7 @@
    (listen-on '("127.0.0.1" "::1"))
    (sensor '("udcf0 correction 70000"))
    (constraint-from '("www.gnu.org"))
-   (constraints-from '("https://www.google.com/"))
-   (allow-large-adjustment? #t)))
+   (constraints-from '("https://www.google.com/"))))
 
 (test-assert "openntpd configuration generation sanity check"
 
diff --git a/tests/packages.scm b/tests/packages.scm
index b3ccd98e48..ff756c6001 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
@@ -45,6 +45,7 @@
   #:use-module (guix memoization)
   #:use-module (guix profiles)
   #:use-module (guix scripts package)
+  #:use-module (guix sets)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages guile)
@@ -58,6 +59,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 vlist)
@@ -1628,17 +1630,27 @@
                                                       result))
                                               '()))))))
 
-    (define (find-duplicates l)
-      (match l
-        (() '())
-        ((head . tail)
-         (if (member head tail)
-             (cons head (find-duplicates tail))
-             (find-duplicates tail)))))
-
-    (pk (find-duplicates from-cache))
-    (and (equal? (delete-duplicates from-cache) from-cache)
-         (lset= equal? no-cache from-cache))))
+    (define (list->set* lst)
+      ;; Return two values: LST represented as a set and the list of
+      ;; duplicates in LST.
+      (let loop ((lst        lst)
+                 (duplicates '())
+                 (seen       (set)))
+        (match lst
+          (()
+           (values seen duplicates))
+          ((head . tail)
+           (if (set-contains? seen head)
+               (loop tail (cons head duplicates) seen)
+               (loop tail duplicates (set-insert head seen)))))))
+
+    ;; Compare FROM-CACHE and NO-CACHE but avoid 'lset=', which exhibits
+    ;; exponential behavior.
+    (let ((set1 duplicates1 (list->set* from-cache))
+          (set2 duplicates2 (list->set* no-cache)))
+      (and (null? duplicates1) (null? duplicates2)
+           (every (cut set-contains? set1 <>) no-cache)
+           (every (cut set-contains? set2 <>) from-cache)))))
 
 (test-assert "find-packages-by-name"
   (match (find-packages-by-name "hello")
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 2dec42bec1..ce77711d63 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -154,6 +154,34 @@
   (manifest-entries (manifest-add (manifest '())
                                   (list guile-2.0.9 guile-2.0.9))))
 
+(test-equal "manifest->code, simple"
+  '(begin
+     (specifications->manifest (list "guile" "guile:debug" "glibc")))
+  (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))))
+
+(test-equal "manifest->code, simple, versions"
+  '(begin
+     (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug"
+                                     "glibc@2.19")))
+  (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))
+                  #:entry-package-version manifest-entry-version))
+
+(test-equal "manifest->code, transformations"
+  '(begin
+     (use-modules (guix transformations))
+
+     (define transform1
+       (options->transformation '((foo . "bar"))))
+
+     (packages->manifest
+      (list (transform1 (specification->package "guile"))
+            (specification->package "glibc"))))
+  (manifest->code (manifest (list (manifest-entry
+                                    (inherit guile-2.0.9)
+                                    (properties `((transformations
+                                                   . ((foo . "bar"))))))
+                                  glibc))))
+
 (test-assert "manifest-perform-transaction"
   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
          (t1 (manifest-transaction
diff --git a/tests/publish.scm b/tests/publish.scm
index cafd0f13a2..52101876b5 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -38,6 +38,7 @@
   #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
   #:use-module (zlib)
   #:use-module (lzlib)
+  #:autoload   (zstd) (call-with-zstd-input-port)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
@@ -54,6 +55,9 @@
 (define %store
   (open-connection-for-tests))
 
+(define (zstd-supported?)
+  (resolve-module '(zstd) #t #f #:ensure #f))
+
 (define %reference (add-text-to-store %store "ref" "foo"))
 
 (define %item (add-text-to-store %store "item" "bar" (list %reference)))
@@ -237,6 +241,18 @@ References: ~%"
          (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
+(unless (zstd-supported?) (test-skip 1))
+(test-equal "/nar/zstd/*"
+  "bar"
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((nar (http-get-port
+                 (publish-uri
+                  (string-append "/nar/zstd/" (basename %item))))))
+       (call-with-zstd-input-port nar
+         (cut restore-file <> temp)))
+     (call-with-input-file temp read-string))))
+
 (test-equal "/*.narinfo with compression"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 17eea38c63..d8f3ce8070 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -123,4 +123,21 @@
          (pk 'welcome-exception! args)
          #t)))))
 
+(test-equal "sqlite-register with incorrect size"
+  'out-of-range
+  (call-with-temporary-output-file
+   (lambda (db-file port)
+     (delete-file db-file)
+     (catch #t
+       (lambda ()
+         (with-database db-file db
+           (sqlite-register db #:path "/gnu/foo"
+                            #:references '("/gnu/bar")
+                            #:deriver "/gnu/foo.drv"
+                            #:hash (string-append "sha256:" (make-string 64 #\e))
+                            #:nar-size -1234))
+         #f)
+       (lambda (key . _)
+         key)))))
+
 (test-end "store-database")
diff --git a/tests/store.scm b/tests/store.scm
index c9a08ac690..cda0e0302f 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -201,6 +201,17 @@
 ;;          (valid-path? %store p1)
 ;;          (member (pk p2) (live-paths %store)))))
 
+(test-assert "add-indirect-root and find-roots"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let* ((item (add-text-to-store %store "something" (random-text)))
+            (root (string-append directory "/gc-root")))
+       (symlink item root)
+       (add-indirect-root %store root)
+       (let ((result (member (cons root item) (find-roots %store))))
+         (delete-file root)
+         result)))))
+
 (test-assert "permanent root"
   (let* ((p  (with-store store
                (let ((p (add-text-to-store store "random-text"
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 542aaf603f..697abc4684 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -19,6 +19,7 @@
 
 (define-module (test-substitute)
   #:use-module (guix scripts substitute)
+  #:use-module (guix narinfo)
   #:use-module (guix base64)
   #:use-module (gcrypt hash)
   #:use-module (guix serialization)
diff --git a/tests/swh.scm b/tests/swh.scm
index 06984b2a80..a36f951241 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,15 +20,32 @@
   #:use-module (guix swh)
   #:use-module (guix tests http)
   #:use-module (web response)
-  #:use-module (srfi srfi-64))
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match))
 
 ;; Test the JSON mapping machinery used in (guix swh).
 
 (define %origin
-  "{ \"visits_url\": \"/visits/42\",
+  "{ \"origin_visits_url\": \"/visits/42\",
      \"type\": \"git\",
      \"url\": \"http://example.org/guix.git\" }")
 
+(define %visits
+  ;; A single visit where 'snapshot_url' is null.
+  ;; See <https://bugs.gnu.org/45615>.
+  "[ {
+    \"origin\": \"https://github.com/Genivia/ugrep\",
+    \"visit\": 1,
+    \"date\": \"2020-05-17T21:43:45.422977+00:00\",
+    \"status\": \"ongoing\",
+    \"snapshot\": null,
+    \"metadata\": {},
+    \"type\": \"git\",
+    \"origin_visit_url\": \"https://archive.softwareheritage.org/api/1/origin/https://github.com/Genivia/ugrep/visit/1/\",
+    \"snapshot_url\": null
+  } ]")
+
 (define %directory-entries
   "[ { \"name\": \"one\",
        \"type\": \"regular\",
@@ -59,6 +76,20 @@
     (parameterize ((%swh-base-url (%local-url)))
       (lookup-origin "http://example.org/whatever"))))
 
+(test-equal "origin-visit, no snapshots"
+  '("https://github.com/Genivia/ugrep"
+    "2020-05-17T21:43:45Z"
+    #f)                                      ;see <https://bugs.gnu.org/45615>
+  (with-http-server `((200 ,%origin)
+                      (200 ,%visits))
+    (parameterize ((%swh-base-url (%local-url)))
+      (let ((origin (lookup-origin "http://example.org/whatever")))
+        (match (origin-visits origin)
+          ((visit)
+           (list (visit-origin visit)
+                 (date->string (visit-date visit) "~4")
+                 (visit-snapshot-url visit))))))))
+
 (test-equal "lookup-directory"
   '(("one" 123) ("two" 456))
   (with-json-result %directory-entries
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 9053deba41..7877029486 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +30,7 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
+  #:use-module (guix upstream)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages busybox)
@@ -396,6 +397,22 @@
               (map local-file-file
                    (origin-patches (package-source dep)))))))))
 
+(test-equal "options->transformation, with-latest"
+  "42.0"
+  (mock ((guix upstream) %updaters
+         (delay (list (upstream-updater
+                       (name 'dummy)
+                       (pred (const #t))
+                       (description "")
+                       (latest (const (upstream-source
+                                       (package "foo")
+                                       (version "42.0")
+                                       (urls '("http://example.org")))))))))
+        (let* ((p (dummy-package "foo" (version "1.0")))
+               (t (options->transformation
+                   `((with-latest . "foo")))))
+          (package-version (t p)))))
+
 (test-end)
 
 ;;; Local Variables:
diff --git a/tests/utils.scm b/tests/utils.scm
index 009e2121ab..62ec7e8b4c 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
@@ -78,6 +78,12 @@
        (not (version-prefix? "4.1" "4.16.2"))
        (not (version-prefix? "4.1" "4"))))
 
+(test-equal "version-unique-prefix"
+  '("2" "2.2" "")
+  (list (version-unique-prefix "2.0" '("3.0" "2.0"))
+        (version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7"))
+        (version-unique-prefix "27.1" '("27.1"))))
+
 (test-equal "string-tokenize*"
   '(("foo")
     ("foo" "bar" "baz")
@@ -182,19 +188,34 @@ skip these tests."
                        method)
     (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                   get-bytevector-all)))
-      (let*-values (((compressed pids1)
-                     (compressed-port method (open-bytevector-input-port data)))
-                    ((decompressed pids2)
-                     (decompressed-port method compressed)))
-        (and (every (compose zero? cdr waitpid)
-                    (pk 'pids method (append pids1 pids2)))
-             (let ((result (get-bytevector-all decompressed)))
-               (pk 'len method
-                   (if (bytevector? result)
-                       (bytevector-length result)
-                       result)
-                   (bytevector-length data))
-               (equal? result data))))))
+      (call-with-temporary-output-file
+       (lambda (output port)
+         (close-port port)
+         (let*-values (((compressed pids)
+                        ;; Note: 'compressed-output-port' only supports file
+                        ;; ports.
+                        (compressed-output-port method
+                                                (open-file output "w0"))))
+           (put-bytevector compressed data)
+           (close-port compressed)
+           (and (every (compose zero? cdr waitpid)
+                       (pk 'pids method pids))
+                (let*-values (((decompressed pids)
+                               (decompressed-port method
+                                                  (open-bytevector-input-port
+                                                   (call-with-input-file output
+                                                     get-bytevector-all))))
+                              ((result)
+                               (get-bytevector-all decompressed)))
+                  (close-port decompressed)
+                  (pk 'len method
+                      (if (bytevector? result)
+                          (bytevector-length result)
+                          result)
+                      (bytevector-length data))
+                  (and (every (compose zero? cdr waitpid)
+                              (pk 'pids method pids))
+                       (equal? result data)))))))))
 
   (false-if-exception (delete-file temp-file))
   (unless (run?) (test-skip 1))
@@ -213,8 +234,10 @@ skip these tests."
                       get-bytevector-all)))))
 
 (for-each test-compression/decompression
-          '(gzip xz lzip)
-          (list (const #t) (const #t) (const #t)))
+          `(gzip xz lzip zstd)
+          (list (const #t) (const #t) (const #t)
+                (lambda ()
+                  (resolve-module '(zstd) #t #f #:ensure #f))))
 
 ;; This is actually in (guix store).
 (test-equal "store-path-package-name"