mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

Fix relative file name canonicalization with empty %LOAD-PATH entries.

Browse source 
* libguile/filesys.c (scm_i_relativize_path): Don't attempt to
  canonicalize when encountering an entry of IN_PATH that is the empty
  string.

* test-suite/tests/ports.test (with-load-path): New macro.
  ("%file-port-name-canonicalization"): New test prefix.
This commit is contained in:
Ludovic Courtès 2012-05-15 19:05:37 +02:00
parent 4eaf64cd46
commit 2ae7b7b6c3
2 changed files with 55 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/filesys.c
View file

@ -1587,32 +1587,40 @@ scm_i_relativize_path (SCM path, SCM in_path)
scanon = scm_take_locale_string (canon);
for (; scm_is_pair (in_path); in_path = scm_cdr (in_path))
if (scm_is_true (scm_string_prefix_p (scm_car (in_path),
scanon,
SCM_UNDEFINED, SCM_UNDEFINED,
SCM_UNDEFINED, SCM_UNDEFINED)))
{
size_t len = scm_c_string_length (scm_car (in_path));
{
SCM dir = scm_car (in_path);
size_t len = scm_c_string_length (dir);
/* The path either has a trailing delimiter or doesn't. scanon will be
delimited by single delimiters. In the case in which the path does
not have a trailing delimiter, add one to the length to strip off the
delimiter within scanon. */
if (!len
/* When DIR is empty, it means "current working directory". We
could set DIR to (getcwd) in that case, but then the
canonicalization would depend on the current directory, which
is not what we want in the context of `compile-file', for
instance. */
if (len > 0
&& scm_is_true (scm_string_prefix_p (dir, scanon,
SCM_UNDEFINED, SCM_UNDEFINED,
SCM_UNDEFINED, SCM_UNDEFINED)))
{
/* DIR either has a trailing delimiter or doesn't. SCANON
will be delimited by single delimiters. When DIR does not
have a trailing delimiter, add one to the length to strip
off the delimiter within SCANON. */
if (
#ifdef __MINGW32__
|| (scm_i_string_ref (scm_car (in_path), len - 1) != '/'
&& scm_i_string_ref (scm_car (in_path), len - 1) != '\\')
(scm_i_string_ref (dir, len - 1) != '/'
&& scm_i_string_ref (dir, len - 1) != '\\')
#else
|| scm_i_string_ref (scm_car (in_path), len - 1) != '/'
scm_i_string_ref (dir, len - 1) != '/'
#endif
)
len++;
)
len++;
if (scm_c_string_length (scanon) > len)
return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED);
else
return SCM_BOOL_F;
}
if (scm_c_string_length (scanon) > len)
return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED);
else
return SCM_BOOL_F;
}
}
return SCM_BOOL_F;
}

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

@ -1087,8 +1087,34 @@
(and (= line line*)
(= col col*)))))))))))
(define-syntax-rule (with-load-path path body ...)
(let ((new path)
(old %load-path))
(dynamic-wind
(lambda ()
(set! %load-path new))
(lambda ()
body ...)
(lambda ()
(set! %load-path old)))))
(with-test-prefix "%file-port-name-canonicalization"
(pass-if "absolute file name & empty %load-path entry"
;; In Guile 2.0.5 and earlier, this would return "dev/null" instead
;; of "/dev/null". See
;; <http://lists.gnu.org/archive/html/guile-devel/2012-05/msg00059.html>
;; for a discussion.
(equal? "/dev/null"
(with-load-path (cons "" (delete "/" %load-path))
(with-fluids ((%file-port-name-canonicalization 'relative))
(port-filename (open-input-file "/dev/null")))))))
(delete-file (test-file))
;;; Local Variables:
;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
;;; eval: (put 'with-load-path 'scheme-indent-function 1)
;;; End: