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

gexp: 'file-union' accepts directory names.

Browse Source 
* guix/gexp.scm (file-union): Import (guix build utils).  Make the
parent directories of TARGET.
* tests/gexp.scm ("file-union"): New test.
This commit is contained in:
Ludovic Courtès 2018-09-08 22:56:40 +02:00
parent e80c725db7
commit 5dec93bb8b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 39 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
guix/gexp.scm
View File

@ -1479,26 +1479,31 @@ denoting the target file. Here's an example:
`((\"hosts\" ,(plain-file \"hosts\" `((\"hosts\" ,(plain-file \"hosts\"
\"127.0.0.1 localhost\")) \"127.0.0.1 localhost\"))
(\"bashrc\" ,(plain-file \"bashrc\" (\"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." This yields an 'etc' directory containing these two files."
(computed-file name (computed-file name
(gexp (with-imported-modules '((guix build utils))
(begin (gexp
(mkdir (ungexp output)) (begin
(chdir (ungexp output)) (use-modules (guix build utils))
(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) (mkdir (ungexp output))
(ungexp target)))))) (chdir (ungexp output))
files)))))) (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 (define* (directory-union name things
#:key (copy? #f) (quiet? #f) #:key (copy? #f) (quiet? #f)

18
tests/gexp.scm
View File

@ -1093,6 +1093,24 @@
(call-with-input-file out get-string-all)) (call-with-input-file out get-string-all))
(equal? refs (list guile)))))))) (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" (test-assert "gexp->derivation vs. %current-target-system"
(let ((mval (gexp->derivation "foo" (let ((mval (gexp->derivation "foo"
#~(begin #~(begin