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

* 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.

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 0211010..514c1ae 100644 (file)
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -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));
-
-        /* 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
+    {
+      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)))
+       {
+         /* 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;
 }

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 5ca416d..07e58f6 100644 (file)
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1087,8 +1087,34 @@
                         (and (= line line*)
                              (= col col*)))))))))))
 
+\f
+
+(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: