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))))