aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/gexp.scm39
-rw-r--r--tests/gexp.scm18
2 files changed, 40 insertions, 17 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index ffc976d61b..f7a23db872 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1479,26 +1479,31 @@ denoting the target file. Here's an example:
`((\"hosts\" ,(plain-file \"hosts\"
\"127.0.0.1 localhost\"))
(\"bashrc\" ,(plain-file \"bashrc\"
- \"alias ls='ls --color'\"))))
+ \"alias ls='ls --color'\"))
+ (\"libvirt/qemu.conf\" ,(plain-file \"qemu.conf\" \"\"))))
This yields an 'etc' directory containing these two files."
(computed-file name
- (gexp
- (begin
- (mkdir (ungexp output))
- (chdir (ungexp output))
- (ungexp-splicing
- (map (match-lambda
- ((target source)
- (gexp
- (begin
- ;; Stat the source to abort early if it does
- ;; not exist.
- (stat (ungexp source))
-
- (symlink (ungexp source)
- (ungexp target))))))
- files))))))
+ (with-imported-modules '((guix build utils))
+ (gexp
+ (begin
+ (use-modules (guix build utils))
+
+ (mkdir (ungexp output))
+ (chdir (ungexp output))
+ (ungexp-splicing
+ (map (match-lambda
+ ((target source)
+ (gexp
+ (begin
+ ;; Stat the source to abort early if it does
+ ;; not exist.
+ (stat (ungexp source))
+
+ (mkdir-p (dirname (ungexp target)))
+ (symlink (ungexp source)
+ (ungexp target))))))
+ files)))))))
(define* (directory-union name things
#:key (copy? #f) (quiet? #f)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index b22e635805..5d049cd5fc 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1093,6 +1093,24 @@
(call-with-input-file out get-string-all))
(equal? refs (list guile))))))))
+(test-assertm "file-union"
+ (mlet* %store-monad ((union -> (file-union "union"
+ `(("a" ,(plain-file "a" "1"))
+ ("b/c/d" ,(plain-file "d" "2"))
+ ("e" ,(plain-file "e" "3")))))
+ (drv (lower-object union))
+ (out -> (derivation->output-path drv)))
+ (define (contents=? file str)
+ (string=? (call-with-input-file (string-append out "/" file)
+ get-string-all)
+ str))
+
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (return (and (contents=? "a" "1")
+ (contents=? "b/c/d" "2")
+ (contents=? "e" "3"))))))
+
(test-assert "gexp->derivation vs. %current-target-system"
(let ((mval (gexp->derivation "foo"
#~(begin