From 3ad2d21671ad56e61c779da253d4396435658198 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 28 Jan 2025 14:51:00 +0100
Subject: [PATCH] =?UTF-8?q?gexp:=20=E2=80=98with-parameters=E2=80=99=20acc?=
 =?UTF-8?q?epts=20plain=20store=20items=20in=20its=20body.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* 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
---
 guix/gexp.scm  | 20 ++++++++++++++------
 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 '() '())