mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix relative file name canonicalization on paths with "."

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-06-23 10:03:10 +02:00
parent d84f25c271
commit 9a95167871
2 changed files with 36 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/filesys.c
View file

@ -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);
{
char *str, *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);
}
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

15
test-suite/tests/ports.test
View file

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