diff options
author | Nigko Yerden <nigko.yerden@gmail.com> | 2024-09-26 12:07:56 +0500 |
---|---|---|
committer | Guix Patches Tester <> | 2024-09-26 11:21:44 +0200 |
commit | 3628fd03c3953a501970bc95269d09bb3e88862c (patch) | |
tree | 32c84180e3d70a103e031cc3c2de17a821c9d9f9 | |
parent | 404dbd894c69c94b483c6139d2a39b1c1eaddf36 (diff) | |
download | guix-patches-issue-72867.tar guix-patches-issue-72867.tar.gz |
gexp: Make 'local-file' follow symlinks.issue-72867
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.
Change-Id: Ieb30101275deb56b7436df444f9bc21d240fba59
-rw-r--r-- | guix/utils.scm | 8 | ||||
-rw-r--r-- | tests/gexp.scm | 33 |
2 files changed, 35 insertions, 6 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index f161cb4ef3..d4591caced 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -1121,11 +1121,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) @@ -1141,7 +1137,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 e066076c5c..cd502a1fb2 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -298,6 +298,39 @@ (equal? (scandir (string-append dir "/tests")) '("." ".." "gexp.scm")))))) +(test-assert "local-file, load through symlink" + ;; See <https://issues.guix.gnu.org/72867>. + (call-with-temporary-directory + (lambda (tmp-dir) + (chdir tmp-dir) + ;; create content file + (call-with-output-file "content" + (lambda (port) (display "Hi!" port))) + ;; Create module that call '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") + (chdir "dir") + (symlink "../test-local-file.scm" "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 path. To test both + ;; of these branches we execute 'test-local-file.scm' symlink + ;; first as a module (corresponds to relative path): + (dynamic-wind + (lambda () (set! %load-path (cons "." %load-path))) + (lambda () (use-modules (test-local-file))) + (lambda () (set! %load-path (cdr %load-path)))) + ;; and then as a regular code (corresponds to absolute path): + (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)))) |