futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Ludovic Courtès 2020-05-25 16:06:03 +02:00
parent e033700f17
commit abf43d4511
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
guix/gexp.scm
View File

@ -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)

14
tests/gexp.scm
View File

@ -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")