tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

gexp: Make 'local-file' follow symlinks.

Browse Source 
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 <pelzflorian@pelzflorian.de>
This commit is contained in:
Nigko Yerden
2024-09-26 12:07:56 +05:00
committed by Florian Pelz
parent 85a44ae636
commit 930ea819a5
2 changed files with 33 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
tests/gexp.scm
View File

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