mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40: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); 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))
if (scm_is_true (scm_string_prefix_p (scm_car (in_path), {
scanon, SCM dir = scm_car (in_path);
SCM_UNDEFINED, SCM_UNDEFINED, size_t len = scm_c_string_length (dir);
SCM_UNDEFINED, SCM_UNDEFINED)))
{
size_t len = scm_c_string_length (scm_car (in_path));
/* The path either has a trailing delimiter or doesn't. scanon will be /* When DIR is empty, it means "current working directory". We
delimited by single delimiters. In the case in which the path does could set DIR to (getcwd) in that case, but then the
not have a trailing delimiter, add one to the length to strip off the canonicalization would depend on the current directory, which
delimiter within scanon. */ is not what we want in the context of `compile-file', for
if (!len 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__ #ifdef __MINGW32__
|| (scm_i_string_ref (scm_car (in_path), len - 1) != '/' (scm_i_string_ref (dir, len - 1) != '/'
&& scm_i_string_ref (scm_car (in_path), len - 1) != '\\') && scm_i_string_ref (dir, len - 1) != '\\')
#else #else
|| scm_i_string_ref (scm_car (in_path), len - 1) != '/' scm_i_string_ref (dir, len - 1) != '/'
#endif #endif
) )
len++; len++;
if (scm_c_string_length (scanon) > len) if (scm_c_string_length (scanon) > len)
return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED); return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED);
else else
return SCM_BOOL_F; return SCM_BOOL_F;
} }
}
return SCM_BOOL_F; return SCM_BOOL_F;
} }

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

@ -1087,8 +1087,34 @@
(and (= line line*) (and (= line line*)
(= col col*))))))))))) (= 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)) (delete-file (test-file))
;;; Local Variables: ;;; Local Variables:
;;; eval: (put 'test-decoding-error 'scheme-indent-function 3) ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
;;; eval: (put 'with-load-path 'scheme-indent-function 1)
;;; End: ;;; End: