~ruther/guix-local

3ad2d21671ad56e61c779da253d4396435658198 — Ludovic Courtès 1 year, 1 month ago 72de375
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
2 files changed, 24 insertions(+), 7 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +14 -6
@@ 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)))))))))


;;;

M tests/gexp.scm => tests/gexp.scm +10 -1
@@ 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 '() '())