mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-06 21:20:33 +02:00
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>
This commit is contained in:
committed by
Ludovic Courtès
parent
749eb1a2dd
commit
30e51cb6b4
@@ -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")
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user