This is an automated email from the git hooks/post-receive script.
guix_mirror_bot pushed a commit to branch master
in repository guix.
The following commit(s) were added to refs/heads/master by this push:
new 930ea819a5 gexp: Make 'local-file' follow symlinks.
930ea819a5 is described below
commit 930ea819a5512c9c55a41eb6eb4ce66c8d3c62d1
Author: Nigko Yerden <[email protected]>
AuthorDate: Thu Sep 26 12:07:56 2024 +0500
gexp: Make 'local-file' follow symlinks.
Fix <https://lists.gnu.org/archive/html/guix-devel/2024-08/msg00047.html>
via making 'current-source-directory' always follow symlinks.
* guix/utils.scm (absolute-dirname, current-source-directory): Make
them follow symlinks.
* tests/gexp.scm ("local-file, load through symlink"): New test.
Fixes: guix/guix#3523
Change-Id: Ieb30101275deb56b7436df444f9bc21d240fba59
Signed-off-by: Florian Pelz <[email protected]>
---
guix/utils.scm | 8 ++------
tests/gexp.scm | 31 +++++++++++++++++++++++++++++++
2 files changed, 33 insertions(+), 6 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 470fb30e2a..56c52fb9d8 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1186,11 +1186,7 @@ failure."
(match (search-path %load-path file)
(#f #f)
((? string? file)
- ;; If there are relative names in %LOAD-PATH, FILE can be relative and
- ;; needs to be canonicalized.
- (if (string-prefix? "/" file)
- (dirname file)
- (canonicalize-path (dirname file)))))))
+ (dirname (canonicalize-path file))))))
(define-syntax current-source-directory
(lambda (s)
@@ -1206,7 +1202,7 @@ be determined."
;; run time rather than expansion time is necessary to allow files
;; to be moved on the file system.
(if (string-prefix? "/" file-name)
- (dirname file-name)
+ (dirname (canonicalize-path file-name))
#`(absolute-dirname #,file-name)))
((or ('filename . #f) #f)
;; raising an error would upset Geiser users
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 00bb729e76..3622324a15 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -314,6 +314,37 @@
(string=? (local-file-absolute-file-name file)
(in-vicinity directory "the-unique-file.txt"))))))
+(test-assert "local-file, load through symlink"
+ ;; See <https://issues.guix.gnu.org/72867>.
+ (call-with-temporary-directory
+ (lambda (tmp-dir)
+ (with-directory-excursion tmp-dir
+ ;; create content file
+ (call-with-output-file "content"
+ (lambda (port) (display "Hi!" port)))
+ ;; Create a module that calls 'local-file' with the "content" file and
+ ;; returns its absolute file name. An error is raised if the "content"
+ ;; file can't be found.
+ (call-with-output-file "test-local-file.scm"
+ (lambda (port) (display "\
+(define-module (test-local-file)
+ #:use-module (guix gexp))
+(define file (local-file \"content\" \"test-file\"))
+(local-file-absolute-file-name file)" port)))
+ (mkdir "dir")
+ (symlink "../test-local-file.scm" "dir/test-local-file.scm")
+ ;; 'local-file' in turn calls 'current-source-directory' which has an
+ ;; 'if' branching condition depending on whether 'file-name' is
+ ;; absolute or relative file name. To test both of these branches we
+ ;; execute 'test-local-file.scm' symlink first as a module (corresponds
+ ;; to relative file name):
+ (dynamic-wind
+ (lambda () (set! %load-path (cons "dir" %load-path)))
+ (lambda () (resolve-module '(test-local-file) #:ensure #f))
+ (lambda () (set! %load-path (cdr %load-path))))
+ ;; and then as a regular code (corresponds to absolute file name):
+ (load (string-append tmp-dir "/dir/test-local-file.scm"))))))
+
(test-assert "one plain file"
(let* ((file (plain-file "hi" "Hello, world!"))
(exp (gexp (display (ungexp file))))
