civodul pushed a commit to branch master
in repository guix.
commit 21221710f247b755f00f851ba7acedbef9bd7def
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sat Apr 5 23:22:47 2025 +0200
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
---
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 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))))
