gexp: 'local-file' canonicalizes its file argument.
Reported by Alex Kost <alezost@gmail.com> at <http://lists.gnu.org/archive/html/guix-devel/2015-06/msg00235.html>. * guix/gexp.scm (local-file): Add call to 'canonicalize-path'. * tests/gexp.scm ("one local file, symlink"): New test.master
parent
69792b285c
commit
7833db1f30
|
@ -167,7 +167,11 @@ designates a flat file and RECURSIVE? is true, its contents are added, and its
|
||||||
permission bits are kept.
|
permission bits are kept.
|
||||||
|
|
||||||
This is the declarative counterpart of the 'interned-file' monadic procedure."
|
This is the declarative counterpart of the 'interned-file' monadic procedure."
|
||||||
(%local-file file name recursive?))
|
;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing to
|
||||||
|
;; do that, when RECURSIVE? is #t, we could end up creating a dangling
|
||||||
|
;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would just
|
||||||
|
;; throw an error, both of which are inconvenient.
|
||||||
|
(%local-file (canonicalize-path file) name recursive?))
|
||||||
|
|
||||||
(define-gexp-compiler (local-file-compiler (file local-file?) system target)
|
(define-gexp-compiler (local-file-compiler (file local-file?) system target)
|
||||||
;; "Compile" FILE by adding it to the store.
|
;; "Compile" FILE by adding it to the store.
|
||||||
|
|
|
@ -109,6 +109,25 @@
|
||||||
(eq? x local)))
|
(eq? x local)))
|
||||||
(equal? `(display ,intd) (gexp->sexp* exp)))))
|
(equal? `(display ,intd) (gexp->sexp* exp)))))
|
||||||
|
|
||||||
|
(test-assert "one local file, symlink"
|
||||||
|
(let ((file (search-path %load-path "guix.scm"))
|
||||||
|
(link (tmpnam)))
|
||||||
|
(dynamic-wind
|
||||||
|
(const #t)
|
||||||
|
(lambda ()
|
||||||
|
(symlink (canonicalize-path file) link)
|
||||||
|
(let* ((local (local-file link "my-file" #:recursive? #f))
|
||||||
|
(exp (gexp (display (ungexp local))))
|
||||||
|
(intd (add-to-store %store "my-file" #f
|
||||||
|
"sha256" file)))
|
||||||
|
(and (gexp? exp)
|
||||||
|
(match (gexp-inputs exp)
|
||||||
|
(((x "out"))
|
||||||
|
(eq? x local)))
|
||||||
|
(equal? `(display ,intd) (gexp->sexp* exp)))))
|
||||||
|
(lambda ()
|
||||||
|
(false-if-exception (delete-file link))))))
|
||||||
|
|
||||||
(test-assert "one plain file"
|
(test-assert "one plain file"
|
||||||
(let* ((file (plain-file "hi" "Hello, world!"))
|
(let* ((file (plain-file "hi" "Hello, world!"))
|
||||||
(exp (gexp (display (ungexp file))))
|
(exp (gexp (display (ungexp file))))
|
||||||
|
|
Reference in New Issue