gexp: ‘local-file’ expands its argument only once.

Fixes a bug whereby (local-file (in-vicinity (getcwd) "xyz")) would
point to different files depending on the current working directory at
the time it is lowered.

* guix/gexp.scm (local-file): Expand FILE only once.
* tests/gexp.scm ("local-file, capture at the right time"): New test.

Change-Id: I2cc23296de3799e68f7d8b7be6061be3043e1176

2 files changed, 30 insertions, 11 deletions

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 811cf02a53..8dd746eee0 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -520,24 +520,27 @@ appears."
       ((_ (assume-source-relative-file-name file) rest ...)
        ;; FILE is not a literal, but the user requested we look it up
        ;; relative to the current source directory.
-       #'(%local-file file
-                      (delay (absolute-file-name file (current-source-directory)))
-                      rest ...))
+       #'(let ((f file))
+           (%local-file f
+                        (delay (absolute-file-name f (current-source-directory)))
+                        rest ...)))
       ((_ (assume-valid-file-name file) rest ...)
        ;; FILE is not a literal, so resolve it relative to the current
        ;; directory.  Since the user declared FILE is valid, do not pass
        ;; #:literal? #f so that we do not warn about it later on.
-       #'(%local-file file
-                      (delay (absolute-file-name file (getcwd)))
-                      rest ...))
+       #'(let ((f file))
+           (%local-file f
+                        (delay (absolute-file-name f (getcwd)))
+                        rest ...)))
       ((_ file rest ...)
        ;; Resolve FILE relative to the current directory.
        (with-syntax ((location (datum->syntax s (syntax-source s))))
-        #`(%local-file file
-                       (delay (absolute-file-name file (getcwd)))
-                       rest ...
-                       #:location 'location
-                       #:literal? #f)))           ;warn if FILE is relative
+         #`(let ((f file))
+             (%local-file f
+                          (delay (absolute-file-name f (getcwd)))
+                          rest ...
+                          #:location 'location
+                          #:literal? #f))))       ;warn if FILE is relative
       ((_)
        #'(syntax-error "missing file name"))
       (id
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 2376c70d1b..00bb729e76 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -298,6 +298,22 @@
                  (equal? (scandir (string-append dir "/tests"))
                          '("." ".." "gexp.scm"))))))
 
+(test-assert "local-file, capture file at the right time"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (call-with-output-file (in-vicinity directory "the-unique-file.txt")
+       (lambda (port)
+         (display "Hi!" port)))
+
+     (let ((file (with-directory-excursion directory
+                   ;; If the argument to 'local-file' were resolved when
+                   ;; 'local-file-absolute-file-name' is called, we'd get the
+                   ;; wrong result.
+                   (local-file (in-vicinity (getcwd)
+                                            "the-unique-file.txt")))))
+       (string=? (local-file-absolute-file-name file)
+                 (in-vicinity directory "the-unique-file.txt"))))))
+
 (test-assert "one plain file"
   (let* ((file     (plain-file "hi" "Hello, world!"))
          (exp      (gexp (display (ungexp file))))