Merge branch 'master' into core-updates

6 files changed, 346 insertions, 131 deletions

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 5a57d51577..e7f1ca8c45 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -6,6 +6,7 @@
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,19 +29,19 @@
 
 ;;; Code:
 
-(import (sxml xpath)
-        (srfi srfi-1)
-        (srfi srfi-2)
-        (srfi srfi-9)
-        (srfi srfi-11)
-        (srfi srfi-26)
-        (ice-9 format)
-        (ice-9 popen)
-        (ice-9 match)
-        (ice-9 rdelim)
-        (ice-9 regex)
-        (ice-9 textual-ports)
-        (guix gexp))
+(use-modules ((sxml xpath) #:prefix xpath:)
+             (srfi srfi-1)
+             (srfi srfi-2)
+             (srfi srfi-9)
+             (srfi srfi-11)
+             (srfi srfi-26)
+             (ice-9 format)
+             (ice-9 popen)
+             (ice-9 match)
+             (ice-9 rdelim)
+             (ice-9 regex)
+             (ice-9 textual-ports)
+             (guix gexp))
 
 (define* (break-string str #:optional (max-line-length 70))
   "Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
@@ -100,12 +101,16 @@ LINE-NO in PORT."
            (read-line port)
            (loop (1- i) last-top-level-sexp))))))
 
+;;; Whether the hunk contains a newly added package (definition), a removed
+;;; package (removal) or something else (#false).
+(define hunk-types '(addition removal #false))
+
 (define-record-type <hunk>
   (make-hunk file-name
              old-line-number
              new-line-number
              diff-lines
-             definition?)
+             type)
   hunk?
   (file-name       hunk-file-name)
   ;; Line number before the change
@@ -114,8 +119,8 @@ LINE-NO in PORT."
   (new-line-number hunk-new-line-number)
   ;; The full diff to be used with "git apply --cached"
   (diff-lines hunk-diff-lines)
-  ;; Does this hunk add a definition?
-  (definition? hunk-definition?))
+  ;; Does this hunk add or remove a package?
+  (type hunk-type))                     ;one of 'hunk-types'
 
 (define* (hunk->patch hunk #:optional (port (current-output-port)))
   (let ((file-name (hunk-file-name hunk)))
@@ -133,25 +138,30 @@ LINE-NO in PORT."
                           ;; new definitions with changes to existing
                           ;; definitions.
                           "--unified=1"
-                          "gnu")))
+                          "--" "gnu")))
     (define (extract-line-number line-tag)
       (abs (string->number
             (car (string-split line-tag #\,)))))
     (define (read-hunk)
       (let loop ((lines '())
-                 (definition? #false))
+                 (type #false))
         (let ((line (read-line port 'concat)))
           (cond
            ((eof-object? line)
-            (values (reverse lines) definition?))
+            (values (reverse lines) type))
            ((or (string-prefix? "@@ " line)
                 (string-prefix? "diff --git" line))
             (unget-string port line)
-            (values (reverse lines) definition?))
+            (values (reverse lines) type))
            (else
             (loop (cons line lines)
-                  (or definition?
-                      (string-prefix? "+(define" line))))))))
+                  (or type
+                      (cond
+                       ((string-prefix? "+(define" line)
+                        'addition)
+                       ((string-prefix? "-(define" line)
+                        'removal)
+                       (else #false)))))))))
     (define info
       (let loop ((acc '())
                  (file-name #f))
@@ -166,13 +176,13 @@ LINE-NO in PORT."
             (match (string-split line #\space)
               ((_ old-start new-start . _)
                (let-values
-                   (((diff-lines definition?) (read-hunk)))
+                   (((diff-lines type) (read-hunk)))
                  (loop (cons (make-hunk file-name
                                         (extract-line-number old-start)
                                         (extract-line-number new-start)
                                         (cons (string-append line "\n")
                                               diff-lines)
-                                        definition?) acc)
+                                        type) acc)
                        file-name)))))
            (else (loop acc file-name))))))
     (close-pipe port)
@@ -214,10 +224,10 @@ corresponding to the top-level definition containing the staged changes."
 (define* (change-commit-message file-name old new #:optional (port (current-output-port)))
   "Print ChangeLog commit message for changes between OLD and NEW."
   (define (get-values expr field)
-    (match ((sxpath `(// ,field quasiquote *)) expr)
+    (match ((xpath:sxpath `(// ,field quasiquote *)) expr)
       (()
        ;; New-style plain lists
-       (match ((sxpath `(// ,field list *)) expr)
+       (match ((xpath:sxpath `(// ,field list *)) expr)
          ((inner) inner)
          (_ '())))
       ;; Old-style labelled inputs
@@ -234,7 +244,7 @@ corresponding to the top-level definition containing the staged changes."
   (define variable-name
     (second old))
   (define version
-    (and=> ((sxpath '(// version *any*)) new)
+    (and=> ((xpath:sxpath '(// version *any*)) new)
            first))
   (format port
           "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
@@ -262,10 +272,18 @@ corresponding to the top-level definition containing the staged changes."
                                           (listify added))))))))))
             '(inputs propagated-inputs native-inputs)))
 
-(define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
-  "Print ChangeLog commit message for a change to FILE-NAME adding a definition."
-  (format port
-          "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
+(define* (add-commit-message file-name variable-name
+                             #:optional (port (current-output-port)))
+  "Print ChangeLog commit message for a change to FILE-NAME adding a
+definition."
+  (format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
+          variable-name file-name variable-name))
+
+(define* (remove-commit-message file-name variable-name
+                                #:optional (port (current-output-port)))
+  "Print ChangeLog commit message for a change to FILE-NAME removing a
+definition."
+  (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
           variable-name file-name variable-name))
 
 (define* (custom-commit-message file-name variable-name message changelog
@@ -344,66 +362,67 @@ modifying."
     (()
      (display "Nothing to be done.\n" (current-error-port)))
     (hunks
-     (let-values
-         (((definitions changes)
-           (partition hunk-definition? hunks)))
+     (let-values (((definitions changes) (partition hunk-type hunks)))
+       ;; Additions/removals.
+       (for-each
+        (lambda (hunk)
+          (and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>)
+                                        (hunk-diff-lines hunk)))
+                     (variable-name (and=> (string-tokenize define-line)
+                                           second))
+                     (commit-message-proc (match (hunk-type hunk)
+                                            ('addition add-commit-message)
+                                            ('removal remove-commit-message))))
+            (commit-message-proc (hunk-file-name hunk) variable-name)
+            (let ((port (open-pipe* OPEN_WRITE
+                                    "git" "apply"
+                                    "--cached"
+                                    "--unidiff-zero")))
+              (hunk->patch hunk port)
+              (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                (error "Cannot apply")))
 
-       ;; Additions.
-       (for-each (lambda (hunk)
-                   (and-let*
-                       ((define-line (find (cut string-prefix? "+(define" <>)
-                                           (hunk-diff-lines hunk)))
-                        (variable-name (and=> (string-tokenize define-line) second)))
-                     (add-commit-message (hunk-file-name hunk) variable-name)
-                     (let ((port (open-pipe* OPEN_WRITE                   
-                                             "git" "apply"                
-                                             "--cached"                   
-                                             "--unidiff-zero")))          
-                       (hunk->patch hunk port)                            
-                       (unless (eqv? 0 (status:exit-val (close-pipe port))) 
-                         (error "Cannot apply")))
+            (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+              (commit-message-proc (hunk-file-name hunk) variable-name port)
+              (usleep %delay)
+              (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                (error "Cannot commit"))))
+          (usleep %delay))
+        definitions))
 
-                     (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
-                       (add-commit-message (hunk-file-name hunk)
-                                           variable-name port)
-                       (usleep %delay)
+     ;; Changes.
+     (for-each
+      (match-lambda
+        ((new old . hunks)
+         (for-each (lambda (hunk)
+                     (let ((port (open-pipe* OPEN_WRITE
+                                             "git" "apply"
+                                             "--cached"
+                                             "--unidiff-zero")))
+                       (hunk->patch hunk port)
                        (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                         (error "Cannot commit"))))
-                   (usleep %delay))
-                 definitions)
-
-       ;; Changes.
-       (for-each (match-lambda
-                   ((new old . hunks)
-                    (for-each (lambda (hunk)
-                                (let ((port (open-pipe* OPEN_WRITE
-                                                        "git" "apply"
-                                                        "--cached"
-                                                        "--unidiff-zero")))
-                                  (hunk->patch hunk port)
-                                  (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                                    (error "Cannot apply")))
-                                (usleep %delay))
-                              hunks)
-                    (define copyright-line
-                      (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
-                                              (const line)))
-                                (hunk-diff-lines (first hunks))))
-                    (cond
-                     (copyright-line
-                      (add-copyright-line copyright-line))
-                     (else
-                      (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
-                        (change-commit-message* (hunk-file-name (first hunks))
-                                                old new)
-                      (change-commit-message* (hunk-file-name (first hunks))
-                                              old new
-                                              port)
-                      (usleep %delay)
-                      (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                        (error "Cannot commit")))))))
-                 ;; XXX: we recompute the hunks here because previous
-                 ;; insertions lead to offsets.
-                 (new+old+hunks (diff-info)))))))
+                         (error "Cannot apply")))
+                     (usleep %delay))
+                   hunks)
+         (define copyright-line
+           (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
+                                      (const line)))
+                (hunk-diff-lines (first hunks))))
+         (cond
+          (copyright-line
+           (add-copyright-line copyright-line))
+          (else
+           (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+             (change-commit-message* (hunk-file-name (first hunks))
+                                     old new)
+             (change-commit-message* (hunk-file-name (first hunks))
+                                     old new
+                                     port)
+             (usleep %delay)
+             (unless (eqv? 0 (status:exit-val (close-pipe port)))
+               (error "Cannot commit")))))))
+      ;; XXX: we recompute the hunks here because previous
+      ;; insertions lead to offsets.
+      (new+old+hunks (diff-info))))))
 
 (apply main (cdr (command-line)))
diff --git a/etc/completion/bash/guix b/etc/completion/bash/guix
index 6b1b70aac1..7b1f639371 100644
--- a/etc/completion/bash/guix
+++ b/etc/completion/bash/guix
@@ -117,58 +117,59 @@ _guix_is_removing ()
     $result
 }
 
+_guix_is_short_option ()
+{
+    case "${COMP_WORDS[$COMP_CWORD - 1]}" in
+	--*)	false;;
+	-*$1)	true ;;
+	*)	false ;;
+    esac
+}
+
+_guix_is_long_option ()
+{
+    # Don't handle (non-GNU?) ‘--long-option VALUE’, as Guix doesn't either.
+    case "${COMP_WORDS[$COMP_CWORD]}" in
+	--$1=*)	true ;;
+	*)	false ;;
+    esac
+}
+
 _guix_is_dash_f ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-f" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --file=*|--install-from-file=*) true;;
-		 *)                              false;;
-	     esac }
+    _guix_is_short_option f ||
+    _guix_is_long_option file ||
+    _guix_is_long_option install-from-file
 }
 
 _guix_is_dash_l ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-l" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --load=*) true;;
-		 *)        false;;
-	     esac }
+    _guix_is_short_option l ||
+    _guix_is_long_option load
 }
 
 _guix_is_dash_L ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-L" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --load-path=*) true;;
-		 *)             false;;
-	     esac }
+    _guix_is_short_option L ||
+    _guix_is_long_option load-path
 }
 
 _guix_is_dash_m ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-m" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --manifest=*) true;;
-		 *)            false;;
-	     esac }
+    _guix_is_short_option m ||
+    _guix_is_long_option manifest
 }
 
 _guix_is_dash_C ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-C" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --channels=*)  true;;
-		 *)             false;;
-	     esac }
+    _guix_is_short_option C ||
+    _guix_is_long_option channels
 }
 
 _guix_is_dash_p ()
 {
-    [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-p" ] \
-	|| { case "${COMP_WORDS[$COMP_CWORD]}" in
-		 --profile=*)   true;;
-		 *)             false;;
-	     esac }
+    _guix_is_short_option p ||
+    _guix_is_long_option profile
 }
 
 _guix_complete_file ()
diff --git a/etc/news.scm b/etc/news.scm
index 56b90501ae..7b14dfb6c6 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -13,7 +13,7 @@
 ;; Copyright © 2021 Leo Famulari <leo@famulari.name>
 ;; Copyright © 2021 Zhu Zihao <all_but_last@163.com>
 ;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
-;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;; Copyright © 2021 Jonathan Brielmaier <jonathan.brielmaier@web.de>
@@ -25,6 +25,167 @@
 (channel-news
  (version 0)
 
+ (entry (commit "35c1edb20ad07250728d3bdcd0296bd0cedaf6bb")
+        (title
+         (en "New @command{edit} sub-commands for services")
+         (de "Neue @command{edit}-Unterbefehle für Dienste")
+         (fr "Nouvelles commandes @command{edit} pour les services")
+         (nl "Nieuwe deelopdracht @command{edit} voor diensten"))
+        (body
+         (en "The new @command{guix system edit} and @command{guix home edit} commands
+allow you to view or edit service types defined for Guix System or Guix Home.
+For example, here is how you would open the definition of the OpenSSH system
+service:
+
+@example
+guix system edit openssh
+@end example
+
+Run @command{info \"(guix) Invoking guix system\"} or @command{info \"(guix)
+Invoking guix home\"} for more info.")
+         (de "Mit den neuen Befehlen @command{guix system edit} und
+@command{guix home edit} können Sie Diensttypen für Guix System oder Guix Home
+betrachten und bearbeiten.  Zum Beispiel würden Sie die Definition des
+OpenSSH-Systemdienstes wie folgt öffnen:
+
+@example
+guix system edit openssh
+@end example
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix system\"} oder
+@command{info \"(guix.de) Aufruf von guix home\"} aus, um mehr zu erfahren.")
+         (fr "Les nouvelles commandes @command{guix system edit} et
+@command{guix home edit} permettent de visualiser ou d'éditer les types de
+services définis pour Guix System ou Guix Home.  Par exemple, voici comment
+ouvrir la définition du service système OpenSSH :
+
+@example
+guix system edit openssh
+@end example
+
+Lancer @command{info \"(guix.fr) Invoquer guix system\"} ou @command{info
+\"(guix.fr) Invoquer guix home\"} pour plus d'informations.")
+         ;; TODO: pas verwijzingen naar de handleiding aan wanneer ze vertaald is
+         (nl "Met de nieuwe bewerkingen @command{guix system edit} en
+@command{guix home edit} kan je dienstsoorten van Guix System en Guix
+Home bekijken en bewerken.  Je kan bijvoorbeeld de definitie van de
+systeemdienst OpenSSH als volgt openen:
+
+@example
+guix system edit openssh
+@end example
+
+Voer @command{info \"(guix) Invoking guix system\"} of @command{info
+\"(guix)Invoking guix home\"} uit voor meer informatie.")))
+
+ (entry (commit "903c82583e1cec4c9ff09d5895c5cc646c37b661")
+        (title
+         (en "New @command{guix import elm} command")
+         (de "Neuer Befehl @command{guix import elm}")
+         (fr "Nouvelle commande @command{guix import elm}"))
+        (body
+         (en "The new @command{guix import elm} command allows packagers to
+generate a package definition or given the name of a package for Elm, a
+functional programming language for the Web:
+
+@example
+guix import elm elm/bytes
+@end example
+
+Run @command{info \"(guix) Invoking guix import\"} for more info.
+
+This comes with a new build system for Elm packages---run @command{info
+\"(guix) Build Systems\"} for details.")
+         (de "Mit dem neuen Befehl @command{guix import elm} können Paketautoren
+eine Paketdefinition anhand des Namens eines Pakets für Elm, einer funktionalen
+Programmiersprache für das Web, erzeugen:
+
+@example
+guix import elm elm/bytes
+@end example
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix import\"} aus, um mehr
+Informationen zu bekommen.
+
+Dazu kommt ein neues Erstellungssystem für Elm-Pakete.  Führen Sie
+@command{info \"(guix.de) Erstellungssysteme\"} aus, um mehr zu erfahren.")
+         (fr "La nouvelle commande @command{guix import elm} permet de générer
+une définition de paquet reposant sur Elm, un langage de programmation
+fonctionnelle pour le Web:
+
+@example
+guix import elm elm/bytes
+@end example
+
+Lancer @command{info \"(guix.fr) Invoquer guix import\"} pour plus
+d'informations.
+
+Cela vient avec un nouveau système de construction pour paquets Elm---lancer
+@command{info \"(guix.fr) Systèmes de construction\"} pour plus de détails.")))
+
+ (entry (commit "b6b2de2a0d52530bc1ee128c61580bed662ee15c")
+        (title (en "Linux-libre kernel updated to 5.17")
+               (de "Linux-libre-Kernel wird auf 5.17 aktualisiert"))
+        (body
+          (en "The default version of the linux-libre kernel has been
+              updated to the 5.17 release series.")
+          (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+jetzt auf der 5.17-Versionsreihe.")))
+
+ (entry (commit "c42b7baf13c7633b4512e94da7445299c57b247d")
+        (title
+         (en "New @option{--export-manifest} option for @command{guix shell}")
+         (de "Neue Option @option{--export-manifest} für @command{guix shell}")
+         (fr "Nouvelle option @option{--export-manifest} de @command{guix shell}"))
+        (body
+         (en "If you use @command{guix shell}, you might wonder how to
+``translate'' a command line into a manifest file that you can keep under
+version control, share with others, and pass to @command{guix shell -m} and in
+fact to most @command{guix} commands.  This is what the new
+@option{--export-manifest} option does.
+
+For example, the command below prints a manifest for the given packages:
+
+@lisp
+guix shell --export-manifest \\
+   -D guile git emacs emacs-geiser emacs-geiser-guile
+@end lisp
+
+Run @code{info \"(guix) Invoking guix shell\"} for more information.")
+         (de "Wenn Sie @command{guix shell} benutzen, haben Sie sich vielleicht
+einmal gefragt, wie Sie eine Befehlszeile in eine Manifest-Datei „übersetzen“
+können, die Sie unter Versionskontrolle stellen können, mit anderen teilen
+können und an @command{guix shell -m} oder tatsächlich die meisten anderen
+@command{guix}-Befehle übergeben können.  Die Antwort ist die neue
+Befehlszeilenoption @option{--export-manifest}.
+
+Zum Beispiel gibt der folgende Befehl ein Manifest mit den genannten Paketen
+aus:
+
+@lisp
+guix shell --export-manifest \\
+   -D guile git emacs emacs-geiser emacs-geiser-guile
+@end lisp
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix shell\"} aus, um mehr
+zu erfahren.")
+         (fr "Si tu utilises @command{guix shell}, tu t'es peut-être déjà
+demandé comment « traduire » une ligne de commande en un fichier manifeste que
+tu puisse garder en gestion de version, partager et passer à @command{guix
+shell -m} et autres commandes @command{guix}.  C'est ce que la nouvelle option
+@option{--export-manifest} fait.
+
+Par exemple, la commande ci-dessous affiche un manifeste pour les paquets
+donnés :
+
+@lisp
+guix shell --export-manifest \\
+   -D guile git emacs emacs-geiser emacs-geiser-guile
+@end lisp
+
+Lancer @code{info \"(guix.fr) Invoquer guix shell\"} pour plus
+d'informations.")))
+
  (entry (commit "094a2cfbe45c104d0da30ff9d975d052ca0c118c")
         (title
          (en "New @command{guix home container} command")
diff --git a/etc/release-manifest.scm b/etc/release-manifest.scm
index e7e64efda4..dd70068490 100644
--- a/etc/release-manifest.scm
+++ b/etc/release-manifest.scm
@@ -23,7 +23,7 @@
 (use-modules (gnu packages)
              (guix packages)
              (guix profiles)
-             ((gnu ci) #:select (%cross-targets))
+             ((guix platform) #:select (targets))
              ((gnu services xorg) #:select (%default-xorg-modules))
              (guix utils)
              (srfi srfi-1)
@@ -144,7 +144,7 @@ TARGET."
                           %packages-to-cross-build)))
                ;; XXX: Important bits like libsigsegv and libffi don't support
                ;; RISCV at the moment, so don't require RISCV support.
-               (delete "riscv64-linux-gnu" %cross-targets))))
+               (delete "riscv64-linux-gnu" (targets)))))
 
 (define %cross-bootstrap-manifest
   (manifest
diff --git a/etc/snippets/text-mode/guix-commit-message-remove-package b/etc/snippets/text-mode/guix-commit-message-remove-package
new file mode 100644
index 0000000000..0c1050f4fe
--- /dev/null
+++ b/etc/snippets/text-mode/guix-commit-message-remove-package
@@ -0,0 +1,13 @@
+# -*- mode: snippet -*-
+# name: guix-commit-message-remove-package
+# key: remove
+# condition: git-commit-mode
+# --
+gnu: Remove ${1:`(with-temp-buffer
+                   (magit-git-wash #'magit-diff-wash-diffs
+                     "diff" "--staged")
+                   (goto-char (point-min))
+                   (when (re-search-forward "\\-(define-public \\(\\S-+\\)" nil 'noerror)
+                     (match-string-no-properties 1)))`}.
+
+* `(car (magit-staged-files))` ($1): Delete variable.
diff --git a/etc/system-tests.scm b/etc/system-tests.scm
index 1085deed24..de6f592dee 100644
--- a/etc/system-tests.scm
+++ b/etc/system-tests.scm
@@ -18,6 +18,8 @@
 
 (use-modules (gnu tests)
              (gnu packages package-management)
+             (guix monads)
+             (guix store)
              ((gnu ci) #:select (channel-source->package))
              ((guix git-download) #:select (git-predicate))
              ((guix utils) #:select (current-source-directory))
@@ -41,6 +43,21 @@ determined."
           (repository-close! repository))
         #f))))
 
+(define-syntax mparameterize
+  (syntax-rules ()
+    "This form implements dynamic scoping, similar to 'parameterize', but in a
+monadic context."
+    ((_ monad ((parameter value) rest ...) body ...)
+     (let ((old-value (parameter)))
+       (mbegin monad
+         ;; XXX: Non-local exits are not correctly handled.
+         (return (parameter value))
+         (mlet monad ((result (mparameterize monad (rest ...) body ...)))
+           (parameter old-value)
+           (return result)))))
+    ((_ monad () body ...)
+     (mbegin monad body ...))))
+
 (define (tests-for-current-guix source commit)
   "Return a list of tests for perform, using Guix built from SOURCE, a channel
 instance."
@@ -48,15 +65,19 @@ instance."
   ;; of tests to run in the usual way:
   ;;
   ;;   make check-system TESTS=installed-os
-  (parameterize ((current-guix-package
-                  (channel-source->package source #:commit commit)))
-    (match (getenv "TESTS")
-      (#f
-       (all-system-tests))
-      ((= string-tokenize (tests ...))
-       (filter (lambda (test)
-                 (member (system-test-name test) tests))
-               (all-system-tests))))))
+  (let ((guix (channel-source->package source #:commit commit)))
+    (map (lambda (test)
+           (system-test
+            (inherit test)
+            (value (mparameterize %store-monad ((current-guix-package guix))
+                     (system-test-value test)))))
+         (match (getenv "TESTS")
+           (#f
+            (all-system-tests))
+           ((= string-tokenize (tests ...))
+            (filter (lambda (test)
+                      (member (system-test-name test) tests))
+                    (all-system-tests)))))))
 
 (define (system-test->manifest-entry test)
   "Return a manifest entry for TEST, a system test."