02/08: gexp: Fix expansion for (file-append (local-file ...) ...).

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit abf43d4511566e97f09049aa8b29453a2ed5ed16
Author: Ludovic Courtès <address@hidden>
AuthorDate: Mon May 25 16:06:03 2020 +0200

    gexp: Fix expansion for (file-append (local-file ...) ...).
    
    Fixes <https://bugs.gnu.org/41527>.
    Regression introduced in d03001a31a6d460b712825640dba11e3f1a53a14.
    
    * guix/gexp.scm (lower+expand-object): When LOWERED is not a struct and
    EXPAND is true, call EXPAND.
    * tests/gexp.scm ("file-append, raw store item"): New test.
---
 guix/gexp.scm  |  4 +++-
 tests/gexp.scm | 14 ++++++++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 78b8af6..9e193c7 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -270,7 +270,9 @@ expand to file names, but it's possible to expand to a 
plain data type."
              (if (not expand)
                  (loop lowered (lookup-expander lowered))
                  (return (expand obj lowered output)))
-             (return lowered)))))))               ;self-quoting
+             (if (not expand)                     ;self-quoting
+                 (return lowered)
+                 (return (expand obj lowered output)))))))))
 
 (define-syntax define-gexp-compiler
   (syntax-rules (=> compiler expander)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 20ef8d2..1beeb67 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -285,6 +285,20 @@
            (((thing "out"))
             (eq? thing file))))))
 
+(test-assert "file-append, raw store item"
+  (let* ((obj   (plain-file "example.txt" "Hello!"))
+         (a     (file-append obj "/a"))
+         (b     (file-append a "/b"))
+         (c     (file-append b "/c"))
+         (exp   #~(list #$c))
+         (item  (run-with-store %store (lower-object obj)))
+         (lexp  (run-with-store %store (lower-gexp exp))))
+    (and (equal? (lowered-gexp-sexp lexp)
+                 `(list ,(string-append item "/a/b/c")))
+         (equal? (lowered-gexp-sources lexp)
+                 (list item))
+         (null? (lowered-gexp-inputs lexp)))))
+
 (test-assertm "with-parameters for %current-system"
   (mlet* %store-monad ((system -> (match (%current-system)
                                     ("aarch64-linux" "x86_64-linux")