Merge branch 'master' into staging

9 files changed, 355 insertions, 42 deletions

diff --git a/tests/elm.scm b/tests/elm.scm
new file mode 100644
index 0000000000..c30623da03
--- /dev/null
+++ b/tests/elm.scm
@@ -0,0 +1,268 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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-elm)
+  #:use-module (guix build-system elm)
+  #:use-module (guix import elm)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
+  #:use-module (guix utils)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
+  #:use-module (json)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-64))
+
+(test-begin "elm")
+
+(test-group "elm->package-name and infer-elm-package-name"
+  (test-group "round trip"
+    ;; Cases when our heuristics can find the upstream name.
+    (define-syntax-rule (test-round-trip elm guix)
+      (test-group elm
+        (test-equal "elm->package-name" guix
+                    (elm->package-name elm))
+        (test-equal "infer-elm-package-name" elm
+                    (infer-elm-package-name guix))))
+    (test-round-trip "elm/core" "elm-core")
+    (test-round-trip "elm/html" "elm-html")
+    (test-round-trip "elm-explorations/markdown" "elm-explorations-markdown")
+    (test-round-trip "elm-explorations/test" "elm-explorations-test")
+    (test-round-trip "elm-explorations/foo-bar" "elm-explorations-foo-bar")
+    (test-round-trip "elm/explorations" "elm-explorations")
+    (test-round-trip "terezka/intervals" "elm-terezka-intervals")
+    (test-round-trip "justinmimbs/time-extra" "elm-justinmimbs-time-extra")
+    (test-round-trip "danhandrea/elm-date-format"
+                     "elm-danhandrea-elm-date-format"))
+  (test-group "upstream-name needed"
+    ;; Upstream names that our heuristic can't infer.  We still check that the
+    ;; round-trip behavior of 'infer-elm-package-name' works as promised for
+    ;; the hypothetical Elm name it doesn't infer.
+    (define-syntax-rule (test-upstream-needed elm guix inferred)
+      (test-group elm
+        (test-equal "elm->package-name" guix
+                    (elm->package-name elm))
+        (test-group "infer-elm-package-name"
+          (test-equal "infers other name" inferred
+                      (infer-elm-package-name guix))
+          (test-equal "infered name round-trips" guix
+                      (elm->package-name inferred)))))
+    (test-upstream-needed "elm/virtual-dom"
+                          "elm-virtual-dom"
+                          "virtual/dom")
+    (test-upstream-needed "elm/project-metadata-utils"
+                          "elm-project-metadata-utils"
+                          "project/metadata-utils")
+    (test-upstream-needed "explorations/foo"
+                          "elm-explorations-foo"
+                          "elm-explorations/foo")
+    (test-upstream-needed "explorations/foo-bar"
+                          "elm-explorations-foo-bar"
+                          "elm-explorations/foo-bar")
+    (test-upstream-needed "explorations-central/foo"
+                          "elm-explorations-central-foo"
+                          "elm-explorations/central-foo")
+    (test-upstream-needed "explorations-central/foo-bar"
+                          "elm-explorations-central-foo-bar"
+                          "elm-explorations/central-foo-bar")
+    (test-upstream-needed "elm-xyz/foo"
+                          "elm-xyz-foo"
+                          "xyz/foo")
+    (test-upstream-needed "elm-xyz/foo-bar"
+                          "elm-xyz-foo-bar"
+                          "xyz/foo-bar")
+    (test-upstream-needed "elm-explorations-xyz/foo"
+                          "elm-explorations-xyz-foo"
+                          "elm-explorations/xyz-foo")
+    (test-upstream-needed "elm-explorations-xyz/foo-bar"
+                          "elm-explorations-xyz-foo-bar"
+                          "elm-explorations/xyz-foo-bar"))
+  (test-group "no inferred Elm name"
+    ;; Cases that 'infer-elm-package-name' should not attempt to handle,
+    ;; because 'elm->package-name' would never produce such names.
+    (define-syntax-rule (test-not-inferred guix)
+      (test-assert guix (not (infer-elm-package-name guix))))
+    (test-not-inferred "elm")
+    (test-not-inferred "guile")
+    (test-not-inferred "gcc-toolchain")
+    (test-not-inferred "font-adobe-source-sans-pro")))
+
+(define test-package-registry-json
+  ;; we intentionally list versions in different orders here
+  "{
+    \"elm/core\": [\"1.0.0\", \"1.0.1\", \"1.0.2\", \"1.0.3\", \"1.0.4\"],
+    \"elm-guix/demo\": [\"2.0.0\", \"3.0.0\", \"1.0.0\"]
+}")
+
+(define test-elm-core-json
+  "{
+    \"type\": \"package\",
+    \"name\": \"elm/core\",
+    \"summary\": \"Elm's standard libraries\",
+    \"license\": \"BSD-3-Clause\",
+    \"version\": \"1.0.4\",
+    \"exposed-modules\": {
+        \"Primitives\": [
+            \"Basics\",
+            \"String\",
+            \"Char\",
+            \"Bitwise\",
+            \"Tuple\"
+        ],
+        \"Collections\": [
+            \"List\",
+            \"Dict\",
+            \"Set\",
+            \"Array\"
+        ],
+        \"Error Handling\": [
+            \"Maybe\",
+            \"Result\"
+        ],
+        \"Debug\": [
+            \"Debug\"
+        ],
+        \"Effects\": [
+            \"Platform.Cmd\",
+            \"Platform.Sub\",
+            \"Platform\",
+            \"Process\",
+            \"Task\"
+        ]
+    },
+    \"elm-version\": \"0.19.0 <= v < 0.20.0\",
+    \"dependencies\": {},
+    \"test-dependencies\": {}
+}")
+
+(define test-elm-core-readme
+  "# Core Libraries
+
+Every Elm project needs this package!
+
+It provides **basic functionality** like addition and subtraction as well as
+**data structures** like lists, dictionaries, and sets.")
+
+(define test-elm-guix-demo-json
+  "{
+    \"type\": \"package\",
+    \"name\": \"elm-guix/demo\",
+    \"summary\": \"A test for `(guix import elm)`\",
+    \"license\": \"GPL-3.0-or-later\",
+    \"version\": \"3.0.0\",
+    \"exposed-modules\": [
+        \"Guix.Demo\"
+    ],
+    \"elm-version\": \"0.19.0 <= v < 0.20.0\",
+    \"dependencies\": {
+        \"elm/core\": \"1.0.0 <= v < 2.0.0\"
+    },
+    \"test-dependencies\": {
+        \"elm/json\": \"1.0.0 <= v < 2.0.0\"
+    }
+}")
+
+(define test-elm-guix-demo-readme
+  ;; intentionally left blank
+  "")
+
+(define (directory-sha256 directory)
+  "Returns the string representing the hash of DIRECTORY as would be used in a
+package definition."
+  (bytevector->nix-base32-string
+   (file-hash* directory
+               #:algorithm (hash-algorithm sha256)
+               #:recursive? #t)))
+
+(test-group "(guix import elm)"
+  (call-with-temporary-directory
+   (lambda (dir)
+     ;; Initialize our fake git checkouts.
+     (define elm-core-dir
+       (string-append dir "/test-elm-core-1.0.4"))
+     (define elm-guix-demo-dir
+       (string-append dir "/test-elm-guix-demo-3.0.0"))
+     (for-each (match-lambda
+                 ((dir json readme)
+                  (mkdir dir)
+                  (with-output-to-file (string-append dir "/elm.json")
+                    (lambda ()
+                      (display json)))
+                  (with-output-to-file (string-append dir "/README.md")
+                    (lambda ()
+                      (display readme)))))
+               `((,elm-core-dir ,test-elm-core-json ,test-elm-core-readme)
+                 (,elm-guix-demo-dir
+                  ,test-elm-guix-demo-json
+                  ,test-elm-guix-demo-readme)))
+     ;; Replace network resources with sample data.
+     (parameterize ((%elm-package-registry
+                     (lambda ()
+                       (json-string->scm test-package-registry-json)))
+                    (%current-elm-checkout
+                     (lambda (name version)
+                       (match (list name version)
+                         (("elm/core" "1.0.4")
+                          elm-core-dir)
+                         (("elm-guix/demo" "3.0.0")
+                          elm-guix-demo-dir)))))
+       (test-assert "(elm->guix-package \"elm/core\")"
+         (match (elm->guix-package "elm/core")
+           (`(package
+               (name "elm-core")
+               (version "1.0.4")
+               (source (elm-package-origin
+                        "elm/core"
+                        version
+                        (base32 ,(? string? hash))))
+               (build-system elm-build-system)
+               (home-page
+                "https://package.elm-lang.org/packages/elm/core/1.0.4")
+               (synopsis "Elm's standard libraries")
+               (description "Every Elm project needs this package!")
+               (license license:bsd-3))
+            (equal? (directory-sha256 elm-core-dir)
+                    hash))
+           (x
+            (raise-exception x))))
+       (test-assert "(elm-recursive-import \"elm-guix/demo\")"
+         (match (elm-recursive-import "elm-guix/demo")
+           (`((package
+                (name "elm-guix-demo")
+                (version "3.0.0")
+                (source (elm-package-origin
+                         "elm-guix/demo"
+                         version
+                         (base32 ,(? string? hash))))
+                (build-system elm-build-system)
+                (propagated-inputs
+                 ,'`(("elm-core" ,elm-core)))
+                (inputs
+                 ,'`(("elm-json" ,elm-json)))
+                (home-page
+                 "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0")
+                (synopsis "A test for `(guix import elm)`")
+                (description
+                 "This package provides a test for `(guix import elm)`")
+                (properties '((upstream-name . "elm-guix/demo")))
+                (license license:gpl3+)))
+            (equal? (directory-sha256 elm-guix-demo-dir)
+                    hash))
+           (x
+            (raise-exception x))))))))
+
+(test-end "elm")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 35bd99e6d4..07e940ffdc 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -502,7 +502,7 @@
                              (ungexp coreutils)
                              (ungexp-native glibc)
                              (ungexp binutils))))
-         (target "mips64el-linux")
+         (target "mips64el-linux-gnu")
          (guile  (derivation->output-path
                   (package-derivation %store %bootstrap-guile)))
          (cu     (derivation->output-path
@@ -547,7 +547,7 @@
                  (gexp->sexp* exp)))))
 
 (test-assert "input list + ungexp-native"
-  (let* ((target "mips64el-linux")
+  (let* ((target "mips64el-linux-gnu")
          (exp   (gexp (display
                        (cons '(ungexp-native (list %bootstrap-guile coreutils))
                              '(ungexp (list glibc binutils))))))
@@ -764,7 +764,7 @@
                         intd)))))
 
 (test-assertm "gexp->derivation, cross-compilation"
-  (mlet* %store-monad ((target -> "mips64el-linux")
+  (mlet* %store-monad ((target -> "mips64el-linux-gnu")
                        (exp    -> (gexp (list (ungexp coreutils)
                                               (ungexp output))))
                        (xdrv      (gexp->derivation "foo" exp
@@ -778,7 +778,7 @@
                  (not (member (derivation-file-name cu) refs))))))
 
 (test-assertm "gexp->derivation, ungexp-native"
-  (mlet* %store-monad ((target -> "mips64el-linux")
+  (mlet* %store-monad ((target -> "mips64el-linux-gnu")
                        (exp    -> (gexp (list (ungexp-native coreutils)
                                               (ungexp output))))
                        (xdrv      (gexp->derivation "foo" exp
@@ -788,7 +788,7 @@
                       (derivation-file-name xdrv)))))
 
 (test-assertm "gexp->derivation, ungexp + ungexp-native"
-  (mlet* %store-monad ((target -> "mips64el-linux")
+  (mlet* %store-monad ((target -> "mips64el-linux-gnu")
                        (exp    -> (gexp (list (ungexp-native coreutils)
                                               (ungexp glibc)
                                               (ungexp output))))
@@ -802,7 +802,7 @@
                  (member (derivation-file-name xglibc) refs)))))
 
 (test-assertm "gexp->derivation, ungexp-native + composed gexps"
-  (mlet* %store-monad ((target -> "mips64el-linux")
+  (mlet* %store-monad ((target -> "mips64el-linux-gnu")
                        (exp0   -> (gexp (list 1 2
                                               (ungexp coreutils))))
                        (exp    -> (gexp (list 0 (ungexp-native exp0))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 1356a74083..f19a0f754e 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -107,7 +107,7 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
 
 # Build a tarball pack of cross-compiled software.  Use coreutils because
 # guile-bootstrap is not intended to be cross-compiled.
-guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
+guix pack --dry-run --bootstrap --target=arm-linux-gnueabihf coreutils
 
 # Likewise, 'guix pack -R' requires a full-blown toolchain (because
 # 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d1b383d2ad..dedba2fd74 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,6 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+# Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 #
 # This file is part of GNU Guix.
 #
@@ -210,6 +211,35 @@ test "$(readlink -f "$profile/bin/guile")" \
 test ! -f "$profile/bin/sed"
 rm "$profile" "$profile"-[0-9]-link
 
+# Make sure transformations apply to propagated inputs and don't lead to
+# conflicts when installing them alongside, see
+# <https://issues.guix.gnu.org/55316>.
+mkdir "$module_dir"
+cat > "$module_dir/test.scm" <<EOF
+(define-module (test)
+  #:use-module (guix packages)
+  #:use-module (gnu packages base)
+  #:use-module (guix build-system trivial))
+
+(define-public dummy-package
+  (package
+    (name "dummy-package")
+    (version "1")
+    (source #f)
+    (build-system trivial-build-system)
+    (propagated-inputs
+     (list hello))
+    (synopsis "dummy")
+    (description "dummy")
+    (home-page "dummy")
+    (license #f)))
+EOF
+guix package -p "$profile" -L "$module_dir"\
+     -i hello dummy-package \
+     --without-tests=hello -n
+rm "$module_dir/test.scm"
+rmdir "$module_dir"
+
 # Profiles with a relative file name.  Make sure we don't create dangling
 # symlinks--see bug report at
 # <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 9992077cb2..56b2fcb7bc 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -62,6 +62,20 @@
            (close-inferior inferior)
            (list a (inferior-object? b))))))
 
+(test-equal "close-inferior"
+  '((hello) (world))
+  (let* ((inferior1 (open-inferior %top-builddir #:command "scripts/guix"))
+         (lst1      (inferior-eval '(list 'hello) inferior1))
+         (inferior2 (open-inferior %top-builddir #:command "scripts/guix"))
+         (lst2      (inferior-eval '(list 'world) inferior2)))
+    ;; This call succeeds if and only if INFERIOR2 does not also hold a file
+    ;; descriptor to the socketpair beneath INFERIOR1; otherwise it blocks.
+    ;; See <https://issues.guix.gnu.org/55441#10>.
+    (close-inferior inferior1)
+
+    (close-inferior inferior2)
+    (list lst1 lst2)))
+
 (test-equal "&inferior-exception"
   '(a b c d)
   (let ((inferior (open-inferior %top-builddir
diff --git a/tests/keys/ed25519-2.pub b/tests/keys/ed25519-2.pub
index f5329105d5..ef050e3845 100644
--- a/tests/keys/ed25519-2.pub
+++ b/tests/keys/ed25519-2.pub
@@ -1,10 +1,9 @@
 -----BEGIN PGP PUBLIC KEY BLOCK-----
 
 mDMEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw
-8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IlgQTFggA
-PhYhBKBDaY1jer75FlruS4IkDtyrgNqDBQJe1Ww2AhsDBQkDwmcABQsJCAcCBhUK
-CQgLAgQWAgMBAh4BAheAAAoJEIIkDtyrgNqDM6cA/idDdoxo9SU+witdTXt24APH
-yRzHbX9Iyh4dZNIek9JwAP9E0BwSvDHB4LY9z4RWf2hJp3dm/yZ/jEpK+w4BGN4J
-Ag==
-=JIU0
+8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IkAQTFggA
+OAIbAwULCQgHAgYVCgkICwIEFgIDAQIeAQIXgBYhBKBDaY1jer75FlruS4IkDtyr
+gNqDBQJihWJtAAoJEIIkDtyrgNqDbs0BAPOaGSYf3pX3DReEe1zbxxVQrolX9/AZ
+VP0AOt0TAgkzAP0Sr7G1NuCtjWWGK1WmlyTFPhOWLhNriKgZFkBZrGypAw==
+=pdTB
 -----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/keys/ed25519-3.pub b/tests/keys/ed25519-3.pub
index 72f311984c..057f29577e 100644
--- a/tests/keys/ed25519-3.pub
+++ b/tests/keys/ed25519-3.pub
@@ -1,9 +1,9 @@
 -----BEGIN PGP PUBLIC KEY BLOCK-----
 
 mDMEYVH/7xYJKwYBBAHaRw8BAQdALMLeUhjEG2/UPCJj2j/debFwwAK5gT3G0l5d
-ILfFldm0FTxleGFtcGxlQGV4YW1wbGUuY29tPoiWBBMWCAA+FiEEjO6M85jMSK68
-7tINGBzA7NyoagkFAmFR/+8CGwMFCQPCZwAFCwkIBwIGFQoJCAsCBBYCAwECHgEC
-F4AACgkQGBzA7Nyoagl3lgEAw6yqIlX11lTqwxBGhZk/Oy34O13cbJSZCGv+m0ja
-+hcA/3DCNOmT+oXjgO/w6enQZUQ1m/d6dUjCc2wOLlLz+ZoG
-=+r3i
+ILfFldm0FTxleGFtcGxlQGV4YW1wbGUuY29tPoiQBBMWCAA4AhsDBQsJCAcCBhUK
+CQgLAgQWAgMBAh4BAheAFiEEjO6M85jMSK687tINGBzA7NyoagkFAmKFYrUACgkQ
+GBzA7Nyoagm2/AD9GSZqQAtEsauo5/LvH3XF7bDDnYCo/SmVCzyLM98+qCsA/2fy
+kKnsGE5kwTGRrNvgn+5ROCCcHFSpwxzWcAwd9S4H
+=OEKB
 -----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/keys/ed25519.pub b/tests/keys/ed25519.pub
index f6bf906783..5a2fccc9f9 100644
--- a/tests/keys/ed25519.pub
+++ b/tests/keys/ed25519.pub
@@ -2,9 +2,9 @@
 
 mDMEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
 b23Hdim0KEVkIFR3by1GaWZ0eSA8bHVkbyt0ZXN0LWVjY0BjaGJvdWliLm9yZz6I
-lgQTFggAPhYhBETTHiGvcTj5tjIoCncfScv6rgctBQJeo1qgAhsDBQkDwmcABQsJ
-CAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEHcfScv6rgctq4MA/1R9G0roEwrHwmTd
-DHxt211eLqupwXE0Z7xY2FH6DHk9AP4owEefBU7jQprSAzBS+c6gdS3SCCKKqAh6
-ToZ4LmbKAw==
-=FXMK
+kAQTFggAOAIbAwULCQgHAgYVCgkICwIEFgIDAQIeAQIXgBYhBETTHiGvcTj5tjIo
+CncfScv6rgctBQJihWH6AAoJEHcfScv6rgctfPMBAPv+yPmEgM+J6D1nZjXsO4zW
++4e3y2Ez+QxgI2tn8Z2xAQDBUWyyu0X+8dguGmVlsaiQdkazaUSpexvIhh9zONYw
+Bg==
+=s4Vp
 -----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/services.scm b/tests/services.scm
index e64b3e8de8..8e35758209 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -30,8 +30,10 @@
 
 (test-equal "services, default value"
   '(42 123 234 error)
-  (let* ((t1 (service-type (name 't1) (extensions '())))
+  (let* ((t1 (service-type (name 't1) (extensions '())
+                           (description "")))
          (t2 (service-type (name 't2) (extensions '())
+                           (description "")
                            (default-value 42))))
     (list (service-value (service t2))
           (service-value (service t2 123))
@@ -40,13 +42,13 @@
             (service t1)))))
 
 (test-assert "service-back-edges"
-  (let* ((t1 (service-type (name 't1) (extensions '())
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
                            (compose +) (extend *)))
-         (t2 (service-type (name 't2)
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1 (const '()))))
                            (compose +) (extend *)))
-         (t3 (service-type (name 't3)
+         (t3 (service-type (name 't3) (description "")
                            (extensions
                             (list (service-extension t2 identity)
                                   (service-extension t1 list)))))
@@ -63,16 +65,16 @@
   ;; from services of type T3; 'xyz 60' comes from the service of type T2,
   ;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4.
   '(initial-value 5 4 3 2 1 xyz 60)
-  (let* ((t1 (service-type (name 't1) (extensions '())
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
                            (compose concatenate)
                            (extend cons)))
-         (t2 (service-type (name 't2)
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1
                                                      (cut list 'xyz <>))))
                            (compose (cut reduce + 0 <>))
                            (extend *)))
-         (t3 (service-type (name 't3)
+         (t3 (service-type (name 't3) (description "")
                            (extensions
                             (list (service-extension t2 identity)
                                   (service-extension t1 list)))))
@@ -86,10 +88,10 @@
          (service-value r))))
 
 (test-assert "fold-services, ambiguity"
-  (let* ((t1 (service-type (name 't1) (extensions '())
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
                            (compose concatenate)
                            (extend cons)))
-         (t2 (service-type (name 't2)
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1 list)))))
          (s  (service t2 42)))
@@ -105,8 +107,8 @@
       #f)))
 
 (test-assert "fold-services, missing target"
-  (let* ((t1 (service-type (name 't1) (extensions '())))
-         (t2 (service-type (name 't2)
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1 list)))))
          (s  (service t2 42)))
@@ -119,11 +121,11 @@
       #f)))
 
 (test-assert "instantiate-missing-services"
-  (let* ((t1 (service-type (name 't1) (extensions '())
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
                            (default-value 'dflt)
                            (compose concatenate)
                            (extend cons)))
-         (t2 (service-type (name 't2)
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1 list)))))
          (s1 (service t1 'hey!))
@@ -135,17 +137,17 @@
                  (instantiate-missing-services (list s1 s2))))))
 
 (test-assert "instantiate-missing-services, indirect"
-  (let* ((t1 (service-type (name 't1) (extensions '())
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")
                            (default-value 'dflt)
                            (compose concatenate)
                            (extend cons)))
-         (t2 (service-type (name 't2)
+         (t2 (service-type (name 't2) (description "")
                            (default-value 'dflt2)
                            (compose concatenate)
                            (extend cons)
                            (extensions
                             (list (service-extension t1 list)))))
-         (t3 (service-type (name 't3)
+         (t3 (service-type (name 't3) (description "")
                            (extensions
                             (list (service-extension t2 list)))))
          (s1 (service t1))
@@ -160,8 +162,8 @@
              (instantiate-missing-services (list s2 s3))))))
 
 (test-assert "instantiate-missing-services, no default value"
-  (let* ((t1 (service-type (name 't1) (extensions '())))
-         (t2 (service-type (name 't2)
+  (let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
+         (t2 (service-type (name 't2) (description "")
                            (extensions
                             (list (service-extension t1 list)))))
          (s  (service t2 42)))