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 <pelzflorian@pelzflorian.de>

1 files changed, 31 insertions, 0 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 00bb729e763..3622324a153 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))))