02/05: gexp: 'file-append' correctly handles bases without an expander.

[guix-commits]

civodul pushed a commit to branch core-updates-frozen
in repository guix.

commit 6b30eb189e48e290136d6a838729cf2eb07ee82f
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Nov 27 22:10:38 2021 +0100

    gexp: 'file-append' correctly handles bases without an expander.
    
    This fixes this use case:
    
      (file-append (let-system ...) ...)
    
    * guix/gexp.scm (file-append-compiler): When BASE lacks an expander,
    delegate to LOWERED.
    * tests/gexp.scm ("let-system in file-append"): New test.
---
 guix/gexp.scm  |  3 ++-
 tests/gexp.scm | 11 +++++++++++
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 56b1bb4..01dca90 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -685,7 +685,8 @@ SUFFIX."
   expander => (lambda (obj lowered output)
                 (match obj
                   (($ <file-append> base suffix)
-                   (let* ((expand (lookup-expander base))
+                   (let* ((expand (or (lookup-expander base)
+                                      (lookup-expander lowered)))
                           (base   (expand base lowered output)))
                      (string-append base (string-concatenate suffix)))))))
 
diff --git a/tests/gexp.scm b/tests/gexp.scm
index b720671..ad8e1d5 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -441,6 +441,17 @@
                   '(system-binding)))
             (x x)))))
 
+(test-assert "let-system in file-append"
+  (let ((mixed (file-append (let-system (system target)
+                              (if (not target) grep sed))
+                            "/bin"))
+        (grep  (file-append grep "/bin"))
+        (sed   (file-append sed "/bin")))
+    (and (equal? (gexp->sexp* #~(list #$mixed))
+                 (gexp->sexp* #~(list #$grep)))
+         (equal? (gexp->sexp* #~(list #$mixed) "powerpc64le-linux-gnu")
+                 (gexp->sexp* #~(list #$sed) "powerpc64le-linux-gnu")))))
+
 (test-assert "ungexp + ungexp-native"
   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile)
                              (ungexp coreutils)