From abf43d4511566e97f09049aa8b29453a2ed5ed16 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 25 May 2020 16:06:03 +0200 Subject: [PATCH] gexp: Fix expansion for (file-append (local-file ...) ...). Fixes . 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 78b8af6fbc..9e193c76c4 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 20ef8d2648..1beeb67c21 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")