mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +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

32
libguile/filesys.c
View file

@ -1587,23 +1587,30 @@ 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);
size_t 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
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,
SCM_UNDEFINED, SCM_UNDEFINED))) SCM_UNDEFINED, SCM_UNDEFINED)))
{ {
size_t len = scm_c_string_length (scm_car (in_path)); /* DIR either has a trailing delimiter or doesn't. SCANON
will be delimited by single delimiters. When DIR does not
/* The path either has a trailing delimiter or doesn't. scanon will be have a trailing delimiter, add one to the length to strip
delimited by single delimiters. In the case in which the path does off the delimiter within SCANON. */
not have a trailing delimiter, add one to the length to strip off the if (
delimiter within scanon. */
if (!len
#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++;
@ -1613,6 +1620,7 @@ scm_i_relativize_path (SCM path, SCM in_path)
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: