amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Ludovic Courtès 2025-04-05 23:22:47 +02:00
parent 649b52b0d4
commit 21221710f2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
guix/gexp.scm
View file

@ -520,24 +520,27 @@ appears."
((_ (assume-source-relative-file-name file) rest ...) ((_ (assume-source-relative-file-name file) rest ...)
;; FILE is not a literal, but the user requested we look it up ;; FILE is not a literal, but the user requested we look it up
;; relative to the current source directory. ;; relative to the current source directory.
#'(%local-file file #'(let ((f file))
(delay (absolute-file-name file (current-source-directory))) (%local-file f
rest ...)) (delay (absolute-file-name f (current-source-directory)))
rest ...)))
((_ (assume-valid-file-name file) rest ...) ((_ (assume-valid-file-name file) rest ...)
;; FILE is not a literal, so resolve it relative to the current ;; FILE is not a literal, so resolve it relative to the current
;; directory. Since the user declared FILE is valid, do not pass ;; directory. Since the user declared FILE is valid, do not pass
;; #:literal? #f so that we do not warn about it later on. ;; #:literal? #f so that we do not warn about it later on.
#'(%local-file file #'(let ((f file))
(delay (absolute-file-name file (getcwd))) (%local-file f
rest ...)) (delay (absolute-file-name f (getcwd)))
rest ...)))
((_ file rest ...) ((_ file rest ...)
;; Resolve FILE relative to the current directory. ;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s)))) (with-syntax ((location (datum->syntax s (syntax-source s))))
#`(%local-file file #`(let ((f file))
(delay (absolute-file-name file (getcwd))) (%local-file f
rest ... (delay (absolute-file-name f (getcwd)))
#:location 'location rest ...
#:literal? #f))) ;warn if FILE is relative #:location 'location
#:literal? #f)))) ;warn if FILE is relative
((_) ((_)
#'(syntax-error "missing file name")) #'(syntax-error "missing file name"))
(id (id

16
tests/gexp.scm
View file

@ -298,6 +298,22 @@
(equal? (scandir (string-append dir "/tests")) (equal? (scandir (string-append dir "/tests"))
'("." ".." "gexp.scm")))))) '("." ".." "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" (test-assert "one plain file"
(let* ((file (plain-file "hi" "Hello, world!")) (let* ((file (plain-file "hi" "Hello, world!"))
(exp (gexp (display (ungexp file)))) (exp (gexp (display (ungexp file))))