diff --git a/guix/utils.scm b/guix/utils.scm index 470fb30e2aa..56c52fb9d8d 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 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 . + (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))))