diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2025-01-28 14:51:00 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2025-01-28 14:56:14 +0100 |
| commit | 3ad2d21671ad56e61c779da253d4396435658198 (patch) | |
| tree | 3e266e37816a326e2e1643044a691edddf115897 | |
| parent | 72de3752f06de2a64fe8135a0839ca25534b326a (diff) | |
gexp: ‘with-parameters’ accepts plain store items in its body.
* guix/gexp.scm (compile-parameterized): Return ‘obj’ as-is when it’s
not a struct.
* tests/gexp.scm ("with-parameters + store item"): New test.
Change-Id: I5b5348b98bce923d07f6fa39b2f0948723011db8
| -rw-r--r-- | guix/gexp.scm | 20 | ||||
| -rw-r--r-- | tests/gexp.scm | 11 |
2 files changed, 24 insertions, 7 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index e44aea64202..ad51bc55b78 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2025 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> @@ -747,7 +747,12 @@ x86_64-linux when COREUTILS is lowered." (target (if (memq %current-target-system parameters) (%current-target-system) target))) - (lower-object (thunk) system #:target target)))))))) + (match (thunk) + ((? struct? obj) + (lower-object obj system #:target target)) + (obj ;store item + (with-monad %store-monad + (return obj))))))))))) expander => (lambda (parameterized lowered output) (match (parameterized-bindings parameterized) @@ -758,10 +763,13 @@ x86_64-linux when COREUTILS is lowered." (with-fluids* fluids (map (lambda (thunk) (thunk)) values) (lambda () - ;; Delegate to the expander of the wrapped object. - (let* ((base (thunk)) - (expand (lookup-expander base))) - (expand base lowered output))))))))) + (match (thunk) + ((? struct? base) + ;; Delegate to the expander of the wrapped object. + (let ((expand (lookup-expander base))) + (expand base lowered output))) + (obj ;store item + obj))))))))) ;;; diff --git a/tests/gexp.scm b/tests/gexp.scm index e066076c5c0..e870f6cb1b9 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2025 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. @@ -467,6 +467,15 @@ (string=? result (string-append (derivation->output-path drv) "/bin/touch")))))) + +(test-assert "with-parameters + store item" + (let* ((file (add-text-to-store %store "hello.txt" "Hello, world!")) + (obj (with-parameters ((%current-system "aarch64-linux")) + file)) + (lowered (run-with-store %store + (lower-object obj)))) + (string=? lowered file))) + (test-equal "let-system" (list `(begin ,(%current-system) #t) '(system-binding) 'low '() '()) |