mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 16:30:19 +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

22
libguile/filesys.c
View file

@ -1614,9 +1614,11 @@ SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0,
SCM SCM
scm_i_relativize_path (SCM path, SCM in_path) scm_i_relativize_path (SCM path, SCM in_path)
{ {
char *str, *canon;
SCM scanon; SCM scanon;
{
char *str, *canon;
str = scm_to_locale_string (path); str = scm_to_locale_string (path);
canon = canonicalize_file_name (str); canon = canonicalize_file_name (str);
free (str); free (str);
@ -1625,11 +1627,27 @@ scm_i_relativize_path (SCM path, SCM in_path)
return SCM_BOOL_F; return SCM_BOOL_F;
scanon = scm_take_locale_string (canon); scanon = scm_take_locale_string (canon);
}
for (; scm_is_pair (in_path); in_path = scm_cdr (in_path)) for (; scm_is_pair (in_path); in_path = scm_cdr (in_path))
{ {
SCM dir = scm_car (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 /* When DIR is empty, it means "current working directory". We
could set DIR to (getcwd) in that case, but then the could set DIR to (getcwd) in that case, but then the

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

@ -1865,14 +1865,15 @@
(with-fluids ((%file-port-name-canonicalization 'relative)) (with-fluids ((%file-port-name-canonicalization 'relative))
(port-filename (open-input-file "/dev/null"))))) (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" (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)) (with-fluids ((%file-port-name-canonicalization 'relative))
(port-filename (port-filename
(open-input-file (%search-load-path "ice-9/q.scm")))) (open-input-file (%search-load-path "ice-9/q.scm")))))
(throw 'unresolved)))
(pass-if-equal "absolute canonicalization from ice-9" (pass-if-equal "absolute canonicalization from ice-9"
(canonicalize-path (canonicalize-path