me
/
guix
Archived
1
0
Fork 0

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
Ludovic Courtès 2015-06-19 10:18:44 +02:00
parent 69792b285c
commit 7833db1f30
2 changed files with 24 additions and 1 deletions

View File

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

View File

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