From 7833db1f30d78aea3b7cb042723c2bd7d00e64ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 19 Jun 2015 10:18:44 +0200 Subject: [PATCH] gexp: 'local-file' canonicalizes its file argument. Reported by Alex Kost at . * guix/gexp.scm (local-file): Add call to 'canonicalize-path'. * tests/gexp.scm ("one local file, symlink"): New test. --- guix/gexp.scm | 6 +++++- tests/gexp.scm | 19 +++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index b3c4166d1a..0b5c43e2b8 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -167,7 +167,11 @@ designates a flat file and RECURSIVE? is true, its contents are added, and its permission bits are kept. 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) ;; "Compile" FILE by adding it to the store. diff --git a/tests/gexp.scm b/tests/gexp.scm index fee7d87d00..32031663f5 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -109,6 +109,25 @@ (eq? x local))) (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" (let* ((file (plain-file "hi" "Hello, world!")) (exp (gexp (display (ungexp file))))