From 30e51cb6b42e86f9f94d6380f69a1020ee99ff39 Mon Sep 17 00:00:00 2001 From: David Elsing Date: Tue, 4 Mar 2025 20:33:08 +0000 Subject: gexp: ‘with-parameters’ properly handles ‘%graft?’. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * .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 Change-Id: I0c74066ca3f37072815b073fb3039925488a9645 Signed-off-by: Ludovic Courtès --- tests/gexp.scm | 20 ++++++++++++++++++++ tests/monads.scm | 20 +++++++++----------- 2 files changed, 29 insertions(+), 11 deletions(-) (limited to 'tests') 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 -- cgit v1.3