gexp: ‘with-parameters’ properly handles ‘%graft?’.

Fixes <https://issues.guix.gnu.org/75879>.

* .dir-locals.el (scheme-mode): Remove mparameterize indentation rules.
Add state-parameterize and store-parameterize indentation rules.
* etc/manifests/system-tests.scm (test-for-current-guix): Replace
mparameterize with store-parameterize.
* etc/manifests/time-travel.scm (guix-instance-compiler): Likewise.
* gnu/tests.scm (compile-system-test): Likewise.
* guix/gexp.scm (compile-parameterized): Use state-call-with-parameters.
* guix/monads.scm (mparameterize): Remove macro.
(state-call-with-parameters): New procedure.
(state-parameterize): New macro.
* guix/store.scm (store-parameterize): New macro.
* tests/gexp.scm ("with-parameters for %graft?"): New test.
* tests/monads.scm ("mparameterize"): Remove test.
("state-parameterize"): New test.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
Change-Id: I0c74066ca3f37072815b073fb3039925488a9645
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 29 insertions, 11 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index e870f6cb1b9..2376c70d1ba 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -451,6 +451,26 @@
     (return (string=? (derivation-file-name drv)
                       (derivation-file-name result)))))
 
+(test-assertm "with-parameters for %graft?"
+  (mlet* %store-monad ((replacement -> (package
+                                         (inherit %bootstrap-guile)
+                                         (name (string-upcase
+                                                (package-name
+                                                 %bootstrap-guile)))))
+                       (guile -> (package
+                                   (inherit %bootstrap-guile)
+                                   (replacement replacement)))
+                       (drv0   (package->derivation %bootstrap-guile))
+                       (drv1   (package->derivation replacement))
+                       (obj0 -> (with-parameters ((%graft? #f))
+                                  guile))
+                       (obj1 -> (with-parameters ((%graft? #t))
+                                  guile))
+                       (result0 (lower-object obj0))
+                       (result1 (lower-object obj1)))
+    (return (and (eq? drv0 result0)
+                 (eq? drv1 result1)))))
+
 (test-assert "with-parameters + file-append"
   (let* ((system (match (%current-system)
                    ("aarch64-linux" "x86_64-linux")
diff --git a/tests/monads.scm b/tests/monads.scm
index 7f255f02bf5..c05d13776a5 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -136,18 +136,16 @@
          %monads
          %monad-run))
 
-(test-assert "mparameterize"
+(test-assert "state-parameterize"
   (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)))
+    (equal?
+     (run-with-state
+         (mlet %state-monad ((outer (return (parameter)))
+                             (inner
+                              (state-parameterize ((parameter 'inside))
+                                  (return (parameter)))))
+           (return (list outer inner (parameter)))))
+     '(outside inside outside))))
 
 (test-assert "mlet* + text-file + package-file"
   (run-with-store %store