Merge branch 'master' into staging

10 files changed, 238 insertions, 445 deletions

diff --git a/tests/build-emacs-utils.scm b/tests/build-emacs-utils.scm
index 081032285a..4e851ed959 100644
--- a/tests/build-emacs-utils.scm
+++ b/tests/build-emacs-utils.scm
@@ -23,6 +23,7 @@
   #:use-module (guix build utils)
   #:use-module ((guix utils)
                 #:select (call-with-temporary-directory))
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64))
 
@@ -36,8 +37,10 @@
 
 (test-assert "emacs-batch-script: raise &emacs-batch-error on failure"
   (guard (c ((emacs-batch-error? c)
-             (string-contains (emacs-batch-error-message c)
-                              "Lisp error: (wrong-type-argument numberp \"three\")")))
+             ;; The error message format changed between Emacs 27 and Emacs
+             ;; 28.
+             (string-match "[Ww]rong.*argument.*numberp.*\"three\""
+                           (emacs-batch-error-message c))))
     (emacs-batch-script '(mapcar 'number-to-string (list 1 2 "three")))))
 
 (call-with-temporary-directory
diff --git a/tests/graph.scm b/tests/graph.scm
index baa08a6be2..6aa2d0e0ff 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -244,10 +244,10 @@ edges."
                         edges)))))))))
 
 (test-assert "reverse bag DAG"
-  (let-values (((dune bap ocaml-base)
-                (values (specification->package "ocaml4.07-dune")
-                        (specification->package "bap")
-                        (specification->package "ocaml4.07-base")))
+  (let-values (((dune camomile utop)
+                (values (specification->package "dune")
+                        (specification->package "ocaml-camomile")
+                        (specification->package "ocaml-utop")))
                ((backend nodes+edges) (make-recording-backend)))
     (run-with-store %store
       (export-graph (list dune) 'port
@@ -256,17 +256,17 @@ edges."
 
     (run-with-store %store
       (mlet %store-monad ((dune-drv       (package->derivation dune))
-                          (bap-drv        (package->derivation bap))
-                          (ocaml-base-drv (package->derivation ocaml-base)))
-        ;; OCAML-BASE uses 'dune-build-system' so DUNE is a direct dependency.
-        ;; BAP is much higher in the stack but it should be there.
+                          (camomile-drv   (package->derivation camomile))
+                          (utop-drv       (package->derivation utop)))
+        ;; CAMOMILE uses 'dune-build-system' so DUNE is a direct dependency.
+        ;; UTOP is much higher in the stack but it should be there.
         (let-values (((nodes edges) (nodes+edges)))
           (return
-           (and (member `(,(derivation-file-name bap-drv)
-                          ,(package-full-name bap))
+           (and (member `(,(derivation-file-name camomile-drv)
+                          ,(package-full-name camomile))
                         nodes)
                 (->bool (member (map derivation-file-name
-                                     (list dune-drv ocaml-base-drv))
+                                     (list dune-drv utop-drv))
                                 edges)))))))))
 
 (test-assert "derivation DAG"
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 56b2fcb7bc..963d405e33 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -30,7 +30,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim))
 
 (define %top-srcdir
   (dirname (search-path %load-path "guix.scm")))
@@ -315,4 +316,40 @@
     (close-inferior inferior)
     (map manifest-entry->list (manifest-entries manifest))))
 
+(test-equal "#:error-port stderr"
+  42
+  ;; There's a special case in open-bidirectional-pipe for
+  ;; (current-error-port) being stderr, so this test just checks that
+  ;; open-inferior doesn't raise an exception
+  (let ((inferior (open-inferior %top-builddir
+                                 #:command "scripts/guix"
+                                 #:error-port (current-error-port))))
+    (and (inferior? inferior)
+         (inferior-eval '(display "test" (current-error-port)) inferior)
+         (let ((result (inferior-eval '(apply * '(6 7)) inferior)))
+           (close-inferior inferior)
+           result))))
+
+(test-equal "#:error-port pipe"
+  "42"
+  (match (pipe)
+    ((port-to-read-from . port-to-write-to)
+
+     (setvbuf port-to-read-from 'line)
+     (setvbuf port-to-write-to 'line)
+
+     (let ((inferior (open-inferior %top-builddir
+                                    #:command "scripts/guix"
+                                    #:error-port port-to-write-to)))
+       (and (inferior? inferior)
+            (begin
+              (inferior-eval '(display "42\n" (current-error-port)) inferior)
+
+              (let loop ((line (read-line port-to-read-from)))
+                (if (string=? line "42")
+                    (begin
+                      (close-inferior inferior)
+                      line)
+                    (loop (read-line port-to-read-from))))))))))
+
 (test-end "inferior")
diff --git a/tests/monads.scm b/tests/monads.scm
index 18bf4119be..19b74f4fb9 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -137,6 +137,19 @@
          %monads
          %monad-run))
 
+(test-assert "mparameterize"
+  (let ((parameter (make-parameter 'outside)))
+    (every (lambda (monad run)
+             (equal?
+              (run (mlet monad ((outer (return (parameter)))
+                                (inner
+                                 (mparameterize monad ((parameter 'inside))
+                                   (return (parameter)))))
+                     (return (list outer inner (parameter)))))
+              '(outside inside outside)))
+           %monads
+           %monad-run)))
+
 (test-assert "mlet* + text-file + package-file"
   (run-with-store %store
     (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile"))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 7418b7470f..7bed946bf3 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -286,6 +286,34 @@
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "profile-derivation format version 3"
+  ;; Make sure we can create and read a version 3 manifest.
+  (mlet* %store-monad
+      ((entry ->    (package->manifest-entry %bootstrap-guile
+                                             #:properties '((answer . 42))))
+       (manifest -> (manifest (list entry)))
+       (drv1        (profile-derivation manifest
+                                        #:format-version 3 ;old version
+                                        #:hooks '()
+                                        #:locales? #f))
+       (drv2        (profile-derivation manifest
+                                        #:hooks '()
+                                        #:locales? #f))
+       (profile1 -> (derivation->output-path drv1))
+       (profile2 -> (derivation->output-path drv2))
+       (_          (built-derivations (list drv1 drv2))))
+    (return (let ((manifest1 (profile-manifest profile1))
+                  (manifest2 (profile-manifest profile2)))
+              (match (manifest-entries manifest1)
+                ((entry1)
+                 (match (manifest-entries manifest2)
+                   ((entry2)
+                    (and (manifest-entry=? entry1 entry2)
+                         (equal? (manifest-entry-properties entry1)
+                                 '((answer . 42)))
+                         (equal? (manifest-entry-properties entry2)
+                                 '((answer . 42))))))))))))
+
 (test-assertm "profile-derivation, ordering & collisions"
   ;; ENTRY1 and ENTRY2 both provide 'bin/guile'--a collision.  Make sure
   ;; ENTRY1 "wins" over ENTRY2.  See <https://bugs.gnu.org/49102>.
@@ -556,14 +584,20 @@
         (return #f)))))
 
 (test-equal "collision of propagated inputs"
-  '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
+  '(("guile-bootstrap" "2.0") "p1"
+    <> ("guile-bootstrap" "42") "p2")
   (guard (c ((profile-collision-error? c)
              (let ((entry1 (profile-collision-error-entry c))
                    (entry2 (profile-collision-error-conflict c)))
                (list (list (manifest-entry-name entry1)
                            (manifest-entry-version entry1))
+                     (manifest-entry-name
+                      (force (manifest-entry-parent entry1)))
+                     '<>
                      (list (manifest-entry-name entry2)
-                           (manifest-entry-version entry2))))))
+                           (manifest-entry-version entry2))
+                     (manifest-entry-name
+                      (force (manifest-entry-parent entry2)))))))
     (run-with-store %store
       (mlet* %store-monad ((p0 -> (package
                                     (inherit %bootstrap-guile)
@@ -580,6 +614,48 @@
                                                     #:locales? #f)))
         (return #f)))))
 
+(test-assertm "deduplication of repeated entries"
+  ;; Make sure the 'manifest' file does not duplicate identical entries.
+  ;; See <https://issues.guix.gnu.org/55499>.
+  (mlet* %store-monad ((p0 -> (dummy-package "p0"
+                                (build-system trivial-build-system)
+                                (arguments
+                                 `(#:guile ,%bootstrap-guile
+                                   #:builder (mkdir (assoc-ref %outputs "out"))))
+                                (propagated-inputs
+                                 `(("guile" ,%bootstrap-guile)))))
+                       (p1 -> (package
+                                (inherit p0)
+                                (name "p1")))
+                       (drv (profile-derivation (packages->manifest
+                                                 (list p0 p1))
+                                                #:hooks '()
+                                                #:locales? #f)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let ((file     (string-append (derivation->output-path drv)
+                                     "/manifest"))
+            (manifest (profile-manifest (derivation->output-path drv))))
+        (define (contains-repeated? sexp)
+          (match sexp
+            (('repeated _ ...) #t)
+            ((lst ...) (any contains-repeated? sexp))
+            (_ #f)))
+
+        (return (and (contains-repeated? (call-with-input-file file read))
+
+                     ;; MANIFEST has two entries for %BOOTSTRAP-GUILE since
+                     ;; it's propagated both from P0 and from P1.  When
+                     ;; reading a 'repeated' node, 'read-manifest' should
+                     ;; reuse the previously-read entry so the two
+                     ;; %BOOTSTRAP-GUILE entries must be 'eq?'.
+                     (match (manifest-entries manifest)
+                       (((= manifest-entry-dependencies (dep0))
+                         (= manifest-entry-dependencies (dep1)))
+                        (and (string=? (manifest-entry-name dep0)
+                                       (package-name %bootstrap-guile))
+                             (eq? dep0 dep1))))))))))
+
 (test-assertm "no collision"
   ;; Here we have an entry that is "lowered" (its 'item' field is a store file
   ;; name) and another entry (its 'item' field is a package) that is
diff --git a/tests/records.scm b/tests/records.scm
index d014e7a995..00c58b0736 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2016, 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -300,6 +300,15 @@
            (string=? (foo-bar r) "baz!")
            (equal? s r)))))
 
+(test-equal "define-record-type* & sanitize without default value"
+  42
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar (sanitize 1+)))
+
+    (foo-bar (foo (bar 41)))))
+
 (test-assert "define-record-type* & sanitize & thunked"
   (let ((sanitized 0))
     (define-record-type* <foo> foo make-foo
@@ -321,6 +330,7 @@
                   (let ((r (foo (inherit q))))
                     (and (string=? (foo-bar r) "baz!")
                          (= sanitized 2)))))))))  ;no re-sanitization
+
 (test-assert "define-record-type* & wrong field specifier"
   (let ((exp '(begin
                 (define-record-type* <foo> foo make-foo
diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 334a1e409b..6268525317 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,7 @@
 
 (define-module (tests services configuration)
   #:use-module (gnu services configuration)
+  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64))
@@ -43,6 +45,17 @@
   80
   (port-configuration-port (port-configuration)))
 
+(test-equal "wrong type for a field"
+  '("configuration.scm" 57 11)                    ;error location
+  (guard (c ((configuration-error? c)
+             (let ((loc (error-location c)))
+               (list (basename (location-file loc))
+                     (location-line loc)
+                     (location-column loc)))))
+    (port-configuration
+     ;; This is line 56; the test relies on line/column numbers!
+     (port "This is not a number!"))))
+
 (define-configuration port-configuration-cs
   (port (number 80) "The port number." empty-serializer))
 
diff --git a/tests/services/telephony.scm b/tests/services/telephony.scm
index b4a0f120d4..52c2a63cd6 100644
--- a/tests/services/telephony.scm
+++ b/tests/services/telephony.scm
@@ -25,400 +25,9 @@
 
 (test-begin "jami-service")
 
-(define parse-dbus-reply
-  (@@ (gnu build jami-service) parse-dbus-reply))
-
-(define parse-account-ids
-  (@@ (gnu build jami-service) parse-account-ids))
-
-(define parse-account-details
-  (@@ (gnu build jami-service) parse-account-details))
-
-(define parse-contacts
-  (@@ (gnu build jami-service) parse-contacts))
-
 (define jami-account->alist
   (@@ (gnu services telephony) jami-account->alist))
 
-;; $ dbus-send --print-reply --dest="cx.ring.Ring" \
-;; "/cx/ring/Ring/ConfigurationManager" \
-;; "cx.ring.Ring.ConfigurationManager.getAccountList"
-(define getAccountList-reply "\
-method return time=1622217253.386711 sender=:1.7 -> destination=:1.14 serial=140 reply_serial=2
-   array [
-      string \"addf37fbb558d6a0\"
-      string \"d5cbeb7d08c98a65\"
-      string \"398af0c6b74ce101\"
-   ]
-")
-
-(test-equal "parse-account-ids"
-  '("addf37fbb558d6a0" "d5cbeb7d08c98a65" "398af0c6b74ce101")
-  (parse-account-ids getAccountList-reply))
-
-;; $ dbus-send --print-reply --dest="cx.ring.Ring" \
-;; "/cx/ring/Ring/ConfigurationManager" \
-;; "cx.ring.Ring.ConfigurationManager.getAccountDetails" \
-;; 'string:398af0c6b74ce101'
-(define getAccountDetails-reply "\
-method return time=1622254991.789588 sender=:1.7 -> destination=:1.19 serial=145 reply_serial=2
-   array [
-      dict entry(
-         string \"Account.accountDiscovery\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.accountPublish\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.activeCallLimit\"
-         string \"-1\"
-      )
-      dict entry(
-         string \"Account.alias\"
-         string \"some-rendezvous-point-name\"
-      )
-      dict entry(
-         string \"Account.allModeratorEnabled\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.allowCertFromContact\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.allowCertFromHistory\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.allowCertFromTrusted\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.archiveHasPassword\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.audioPortMax\"
-         string \"32766\"
-      )
-      dict entry(
-         string \"Account.audioPortMin\"
-         string \"16384\"
-      )
-      dict entry(
-         string \"Account.autoAnswer\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.defaultModerators\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.deviceID\"
-         string \"94b4070fc7a8afa8482c777a9822c52e6af2e1bd\"
-      )
-      dict entry(
-         string \"Account.deviceName\"
-         string \"some-device\"
-      )
-      dict entry(
-         string \"Account.dhtProxyListUrl\"
-         string \"https://config.jami.net/proxyList\"
-      )
-      dict entry(
-         string \"Account.displayName\"
-         string \"some-rendezvous-point-name\"
-      )
-      dict entry(
-         string \"Account.dtmfType\"
-         string \"overrtp\"
-      )
-      dict entry(
-         string \"Account.enable\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.hasCustomUserAgent\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.hostname\"
-         string \"bootstrap.jami.net\"
-      )
-      dict entry(
-         string \"Account.localInterface\"
-         string \"default\"
-      )
-      dict entry(
-         string \"Account.localModeratorsEnabled\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.mailbox\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.managerUri\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.managerUsername\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.peerDiscovery\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.presenceSubscribeSupported\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.proxyEnabled\"
-         string \"false\"
-      )
-      dict entry(
-         string \"Account.proxyPushToken\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.proxyServer\"
-         string \"dhtproxy.jami.net:[80-95]\"
-      )
-      dict entry(
-         string \"Account.publishedAddress\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.publishedPort\"
-         string \"5060\"
-      )
-      dict entry(
-         string \"Account.publishedSameAsLocal\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.rendezVous\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.ringtoneEnabled\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.ringtonePath\"
-         string \"/usr/share/ring/ringtones/default.opus\"
-      )
-      dict entry(
-         string \"Account.type\"
-         string \"RING\"
-      )
-      dict entry(
-         string \"Account.upnpEnabled\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.useragent\"
-         string \"\"
-      )
-      dict entry(
-         string \"Account.username\"
-         string \"ccb8bbe2382343f7feb140710ab48aaf1b55634e\"
-      )
-      dict entry(
-         string \"Account.videoEnabled\"
-         string \"true\"
-      )
-      dict entry(
-         string \"Account.videoPortMax\"
-         string \"65534\"
-      )
-      dict entry(
-         string \"Account.videoPortMin\"
-         string \"49152\"
-      )
-      dict entry(
-         string \"DHT.PublicInCalls\"
-         string \"true\"
-      )
-      dict entry(
-         string \"DHT.port\"
-         string \"7766\"
-      )
-      dict entry(
-         string \"RingNS.account\"
-         string \"3989b55313a911b6f0c004748b49b254f35c9ef6\"
-      )
-      dict entry(
-         string \"RingNS.uri\"
-         string \"\"
-      )
-      dict entry(
-         string \"SRTP.enable\"
-         string \"true\"
-      )
-      dict entry(
-         string \"SRTP.keyExchange\"
-         string \"sdes\"
-      )
-      dict entry(
-         string \"SRTP.rtpFallback\"
-         string \"false\"
-      )
-      dict entry(
-         string \"STUN.enable\"
-         string \"false\"
-      )
-      dict entry(
-         string \"STUN.server\"
-         string \"\"
-      )
-      dict entry(
-         string \"TLS.certificateFile\"
-         string \"/var/lib/jami/.local/share/jami/398af0c6b74ce101/ring_device.crt\"
-      )
-      dict entry(
-         string \"TLS.certificateListFile\"
-         string \"\"
-      )
-      dict entry(
-         string \"TLS.ciphers\"
-         string \"\"
-      )
-      dict entry(
-         string \"TLS.method\"
-         string \"Automatic\"
-      )
-      dict entry(
-         string \"TLS.negotiationTimeoutSec\"
-         string \"-1\"
-      )
-      dict entry(
-         string \"TLS.password\"
-         string \"\"
-      )
-      dict entry(
-         string \"TLS.privateKeyFile\"
-         string \"/var/lib/jami/.local/share/jami/398af0c6b74ce101/ring_device.key\"
-      )
-      dict entry(
-         string \"TLS.requireClientCertificate\"
-         string \"true\"
-      )
-      dict entry(
-         string \"TLS.serverName\"
-         string \"\"
-      )
-      dict entry(
-         string \"TLS.verifyClient\"
-         string \"true\"
-      )
-      dict entry(
-         string \"TLS.verifyServer\"
-         string \"true\"
-      )
-      dict entry(
-         string \"TURN.enable\"
-         string \"true\"
-      )
-      dict entry(
-         string \"TURN.password\"
-         string \"ring\"
-      )
-      dict entry(
-         string \"TURN.realm\"
-         string \"ring\"
-      )
-      dict entry(
-         string \"TURN.server\"
-         string \"turn.jami.net\"
-      )
-      dict entry(
-         string \"TURN.username\"
-         string \"ring\"
-      )
-   ]
-")
-
-(test-equal "parse-account-details; username, alias and display name"
-  '("ccb8bbe2382343f7feb140710ab48aaf1b55634e" ;username
-    "some-rendezvous-point-name"               ;alias
-    "some-rendezvous-point-name")              ;displayName
-  (let ((account-details (parse-account-details getAccountDetails-reply)))
-    (list (assoc-ref account-details "Account.username")
-          (assoc-ref account-details "Account.alias")
-          (assoc-ref account-details "Account.displayName"))))
-
-(define getContacts-reply "\
-method return time=1627014042.752673 sender=:1.113 -> destination=:1.186 serial=220 reply_serial=2
-   array [
-      array [
-         dict entry(
-            string \"added\"
-            string \"1578883327\"
-         )
-         dict entry(
-            string \"confirmed\"
-            string \"true\"
-         )
-         dict entry(
-            string \"id\"
-            string \"1c7d5a09464223442549fef172a3cf6f4de9b01c\"
-         )
-      ]
-      array [
-         dict entry(
-            string \"added\"
-            string \"1623107941\"
-         )
-         dict entry(
-            string \"confirmed\"
-            string \"true\"
-         )
-         dict entry(
-            string \"id\"
-            string \"5903c6c9ac5cb863c64e559add3d5d1c8c563449\"
-         )
-      ]
-      array [
-         dict entry(
-            string \"added\"
-            string \"1595996256\"
-         )
-         dict entry(
-            string \"confirmed\"
-            string \"true\"
-         )
-         dict entry(
-            string \"id\"
-            string \"ff2d72a548693214fb3a0f0f7a943b5e2bb9be03\"
-         )
-      ]
-   ]")
-
-(test-equal "parse-account-contacts"
-  '((("added" . "1578883327")
-     ("confirmed" . "true")
-     ("id" . "1c7d5a09464223442549fef172a3cf6f4de9b01c"))
-    (("added" . "1623107941")
-     ("confirmed" . "true")
-     ("id" . "5903c6c9ac5cb863c64e559add3d5d1c8c563449"))
-    (("added" . "1595996256")
-     ("confirmed" . "true")
-     ("id" . "ff2d72a548693214fb3a0f0f7a943b5e2bb9be03")))
-  (parse-contacts getContacts-reply))
-
-(define getContacts-empty-reply "\
-method return time=1627400787.873988 sender=:1.1197 -> destination=:1.1463 serial=2127 reply_serial=2
-   array [
-   ]")
-
-(test-equal "parse-account-contacts, empty array"
-  '()
-  (parse-contacts getContacts-empty-reply))
-
 (define %dummy-jami-account (jami-account
                              (archive "/tmp/dummy.gz")))
 
diff --git a/tests/status.scm b/tests/status.scm
index 01a61f7345..b0af619872 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,8 +19,8 @@
 (define-module (test-status)
   #:use-module (guix status)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 match))
@@ -29,8 +29,7 @@
 
 (test-equal "compute-status, no-op"
   (build-status)
-  (let-values (((port get-status)
-                (build-event-output-port compute-status)))
+  (let ((port get-status (build-event-output-port compute-status)))
     (display "foo\nbar\n\baz\n" port)
     (get-status)))
 
@@ -53,11 +52,11 @@
                                               #:transferred 500
                                               #:start 'now
                                               #:end 'now)))))
-  (let-values (((port get-status)
-                (build-event-output-port (lambda (event status)
-                                           (compute-status event status
-                                                           #:current-time
-                                                           (const 'now))))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
     (display "@ build-started foo.drv - x86_64-linux \n" port)
     (display "@ substituter-started bar\n" port)
     (display "@ download-started bar http://example.org/bar 500\n" port)
@@ -100,11 +99,11 @@
                                               #:start 'now
                                               #:end 'now)))))
   ;; Below we omit 'substituter-started' events and the like.
-  (let-values (((port get-status)
-                (build-event-output-port (lambda (event status)
-                                           (compute-status event status
-                                                           #:current-time
-                                                           (const 'now))))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
     (display "@ build-started foo.drv - x86_64-linux foo.log\n" port)
     (display "@ download-started bar http://example.org/bar 999\n" port)
     (display "various\nthings\nget\nwritten\n" port)
@@ -119,17 +118,31 @@
 
 (test-equal "build-output-port, UTF-8"
   '((build-log #f "lambda is λ!\n"))
-  (let-values (((port get-status) (build-event-output-port cons '()))
-               ((bv)              (string->utf8 "lambda is λ!\n")))
+  (let ((port get-status (build-event-output-port cons '()))
+        (bv              (string->utf8 "lambda is λ!\n")))
     (put-bytevector port bv)
     (force-output port)
     (get-status)))
 
+(test-equal "build-output-port, daemon messages with LF"
+  '((build-log #f "updating substitutes... 0%\r")
+    (build-log #f "updating substitutes... 50%\r")
+    (build-log #f "updating substitutes... 100%\r"))
+  (let ((port get-status (build-event-output-port cons '())))
+    (for-each (lambda (suffix)
+                (let ((bv (string->utf8
+                           (string-append "updating substitutes... "
+                                          suffix "\r"))))
+                  (put-bytevector port bv)
+                  (force-output port)))
+              '("0%" "50%" "100%"))
+    (reverse (get-status))))
+
 (test-equal "current-build-output-port, UTF-8 + garbage"
   ;; What about a mixture of UTF-8 + garbage?
   (let ((replacement "�"))
     `((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
-  (let-values (((port get-status) (build-event-output-port cons '())))
+  (let ((port get-status (build-event-output-port cons '())))
     (display "garbage: " port)
     (put-bytevector port #vu8(128))
     (put-bytevector port (string->utf8 "lambda: λ\n"))
@@ -156,14 +169,14 @@
                                               #:transferred 999
                                               #:start 'now
                                               #:end 'now)))))
-  (let-values (((port get-status)
-                (build-event-output-port (lambda (event status)
-                                           (compute-status event status
-                                                           #:current-time
-                                                           (const 'now)
-                                                           #:derivation-path->output-path
-                                                           (match-lambda
-                                                             ("bar.drv" "bar")))))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now)
+                                                         #:derivation-path->output-path
+                                                         (match-lambda
+                                                           ("bar.drv" "bar")))))))
     (display "@ build-started foo.drv - x86_64-linux  121\n" port)
     (display "@ build-started bar.drv - armhf-linux bar.log 144\n" port)
     (display "@ build-log 121 6\nHello!" port)
@@ -192,11 +205,11 @@
         (build-status
          (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
                                         #:completion 100.)))))
-  (let-values (((port get-status)
-                (build-event-output-port (lambda (event status)
-                                           (compute-status event status
-                                                           #:current-time
-                                                           (const 'now))))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
     (display "@ build-started foo.drv - x86_64-linux  121\n" port)
     (display "@ build-log 121 6\nHello!" port)
     (let ((first (get-status)))
@@ -225,11 +238,11 @@
         (build-status
          (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
                                         #:phase 'install)))))
-  (let-values (((port get-status)
-                (build-event-output-port (lambda (event status)
-                                           (compute-status event status
-                                                           #:current-time
-                                                           (const 'now))))))
+  (let ((port get-status
+              (build-event-output-port (lambda (event status)
+                                         (compute-status event status
+                                                         #:current-time
+                                                         (const 'now))))))
     (display "@ build-started foo.drv - x86_64-linux  121\n" port)
     (display "@ build-log 121 27\nstarting phase `configure'\n" port)
     (display "@ build-log 121 6\nabcde!" port)
diff --git a/tests/style.scm b/tests/style.scm
index 48d975df94..55bad2b3ba 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -504,6 +504,25 @@ mnopqrstuvwxyz.\")"
          #:make-flags #~'(\"ANSWER=42\")
          #:tests? #f)))")
 
+(test-pretty-print "\
+(let ((x 1)
+      (y 2)
+      (z (let* ((a 3)
+                (b 4))
+           (+ a b))))
+  (list x y z))")
+
+(test-pretty-print "\
+(substitute-keyword-arguments (package-arguments x)
+  ((#:phases phases)
+   `(modify-phases ,phases
+      (add-before 'build 'do-things
+        (lambda _
+          #t))))
+  ((#:configure-flags flags)
+   `(cons \"--without-any-problem\"
+          ,flags)))")
+
 (test-equal "pretty-print-with-comments, canonicalize-comment"
   "\
 (list abc