ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: 'imported-files/derivation' can copy files instead of symlinking.

Browse source 
* guix/gexp.scm (imported-files/derivation): Add #:symlink? and honor
it.
(imported-files): Pass #:symlink? to 'imported-files/derivation'.
* tests/gexp.scm ("imported-files with file-like objects"): Add 'file=?'
and use it instead of calling 'readlink'.
This commit is contained in:
Ludovic Courtès 2018-07-16 11:40:34 +02:00
parent 8df2eca6b0
commit e529d46828
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 13 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
guix/gexp.scm
View file

@ -1078,6 +1078,7 @@ (define %utils-module
(define* (imported-files/derivation files
#:key (name "file-import")
(symlink? #f)
(system (%current-system))
(guile (%guile-for-build))
@ -1091,7 +1092,8 @@ (define* (imported-files/derivation files
"Return a derivation that imports FILES into STORE. FILES must be a list
of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the
resulting store path. FILE can be either a file name, or a file-like object,
as returned by 'local-file' for example."
as returned by 'local-file' for example. If SYMLINK? is true, create symlinks
to the source files instead of copying them."
(define file-pair
(match-lambda
((final-path . (? string? file-name))
@ -1114,7 +1116,8 @@ (define build
(for-each (match-lambda
((final-path store-path)
(mkdir-p (dirname final-path))
(symlink store-path final-path)))
((ungexp (if symlink? 'symlink 'copy-file))
store-path final-path)))
'(ungexp files)))))
;; TODO: Pass FILES as an environment variable so that BUILD remains
@ -1160,6 +1163,7 @@ (define* (imported-files files
(_ #f))
files))
(imported-files/derivation files #:name name
#:symlink? derivation?
#:system system #:guile guile
#:deprecation-warnings deprecation-warnings)
(interned-file-tree `(,name directory

11
tests/gexp.scm
View file

@ -652,16 +652,19 @@ (define guile ,guile)
(files -> `(("a/b/c" . ,q-scm)
("p/q" . ,plain)))
(drv (imported-files files)))
(define (file=? file1 file2)
;; Assume deduplication is in place.
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))
(mbegin %store-monad
(built-derivations (list drv))
(mlet %store-monad ((dir -> (derivation->output-path drv))
(plain* (text-file "foo" "bar!"))
(q-scm* (interned-file q-scm "c")))
(return
(and (string=? (readlink (string-append dir "/a/b/c"))
q-scm*)
(string=? (readlink (string-append dir "/p/q"))
plain*)))))))
(and (file=? (string-append dir "/a/b/c") q-scm*)
(file=? (string-append dir "/p/q") plain*)))))))
(test-equal "gexp-modules & ungexp"
'((bar) (foo))