From 21221710f247b755f00f851ba7acedbef9bd7def Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 5 Apr 2025 23:22:47 +0200
Subject: [PATCH] =?UTF-8?q?gexp:=20=E2=80=98local-file=E2=80=99=20expands?=
 =?UTF-8?q?=20its=20argument=20only=20once.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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
---
 guix/gexp.scm  | 25 ++++++++++++++-----------
 tests/gexp.scm | 16 ++++++++++++++++
 2 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 811cf02a533..8dd746eee0e 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 2376c70d1ba..00bb729e763 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))))