gexp: Fix expansion for (file-append (local-file ...) ...).
Fixes <https://bugs.gnu.org/41527>.
Regression introduced in d03001a31a
.
* 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.
master
parent
e033700f17
commit
abf43d4511
|
@ -270,7 +270,9 @@ expand to file names, but it's possible to expand to a plain data type."
|
||||||
(if (not expand)
|
(if (not expand)
|
||||||
(loop lowered (lookup-expander lowered))
|
(loop lowered (lookup-expander lowered))
|
||||||
(return (expand obj lowered output)))
|
(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
|
(define-syntax define-gexp-compiler
|
||||||
(syntax-rules (=> compiler expander)
|
(syntax-rules (=> compiler expander)
|
||||||
|
|
|
@ -285,6 +285,20 @@
|
||||||
(((thing "out"))
|
(((thing "out"))
|
||||||
(eq? thing file))))))
|
(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"
|
(test-assertm "with-parameters for %current-system"
|
||||||
(mlet* %store-monad ((system -> (match (%current-system)
|
(mlet* %store-monad ((system -> (match (%current-system)
|
||||||
("aarch64-linux" "x86_64-linux")
|
("aarch64-linux" "x86_64-linux")
|
||||||
|
|
Reference in New Issue