diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-23 10:03:10 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-23 10:17:57 +0200 |
commit | 9a951678713557b548415d32eae6d63d039bf652 (patch) | |
tree | 4bcb8a5e7d28db9b555d21ac257854c5f77e62e0 | |
parent | d84f25c2713f8b4bf5fba7d17e0284849d82c4ca (diff) | |
download | guile-9a951678713557b548415d32eae6d63d039bf652.tar.gz |
Fix relative file name canonicalization on paths with "."
* libguile/filesys.c (scm_i_relativize_path): Canonicalize the file
names elements that we will be using as prefixes. Fixes the case
where a load path contains a relative file name: #19540.
* test-suite/tests/ports.test ("%file-port-name-canonicalization"): Add
tests that elements of the load path are canonicalized.
-rw-r--r-- | libguile/filesys.c | 36 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 15 |
2 files changed, 35 insertions, 16 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 7674498a4..25501ef76 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1614,22 +1614,40 @@ SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0, SCM scm_i_relativize_path (SCM path, SCM in_path) { - char *str, *canon; SCM scanon; - str = scm_to_locale_string (path); - canon = canonicalize_file_name (str); - free (str); - - if (!canon) - return SCM_BOOL_F; + { + char *str, *canon; - scanon = scm_take_locale_string (canon); + str = scm_to_locale_string (path); + canon = canonicalize_file_name (str); + free (str); + if (!canon) + return SCM_BOOL_F; + + scanon = scm_take_locale_string (canon); + } + for (; scm_is_pair (in_path); in_path = scm_cdr (in_path)) { SCM dir = scm_car (in_path); - size_t len = scm_c_string_length (dir); + size_t len; + + /* Try to canonicalize DIR, since we have canonicalized PATH. */ + { + char *str, *canon; + + str = scm_to_locale_string (dir); + canon = canonicalize_file_name (str); + free (str); + + if (canon) + dir = scm_from_locale_string (canon); + free (canon); + } + + len = scm_c_string_length (dir); /* When DIR is empty, it means "current working directory". We could set DIR to (getcwd) in that case, but then the diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index dfa430e5a..ea8eaa796 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -1865,14 +1865,15 @@ (with-fluids ((%file-port-name-canonicalization 'relative)) (port-filename (open-input-file "/dev/null"))))) + (pass-if-equal "relative canonicalization with /dev/.." "dev/null" + (with-load-path (cons "/dev/.." %load-path) + (with-fluids ((%file-port-name-canonicalization 'relative)) + (port-filename (open-input-file "/dev/null"))))) + (pass-if-equal "relative canonicalization from ice-9" "ice-9/q.scm" - ;; If an entry in %LOAD-PATH is not canonical, then - ;; `scm_i_relativize_path' is unable to do its job. - (if (equal? (map canonicalize-path %load-path) %load-path) - (with-fluids ((%file-port-name-canonicalization 'relative)) - (port-filename - (open-input-file (%search-load-path "ice-9/q.scm")))) - (throw 'unresolved))) + (with-fluids ((%file-port-name-canonicalization 'relative)) + (port-filename + (open-input-file (%search-load-path "ice-9/q.scm"))))) (pass-if-equal "absolute canonicalization from ice-9" (canonicalize-path |