summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--guix/gexp.scm6
-rw-r--r--tests/gexp.scm19
2 files changed, 24 insertions, 1 deletions
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))))