[Guile-commits] 01/01: Fix relative file name canonicalization on paths with "."

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 9a951678713557b548415d32eae6d63d039bf652
Author: Andy Wingo <address@hidden>
Date:   Thu Jun 23 10:03:10 2016 +0200

    Fix relative file name canonicalization on paths with "."
    
    * 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.
---
 libguile/filesys.c          |   36 +++++++++++++++++++++++++++---------
 test-suite/tests/ports.test |   15 ++++++++-------
 2 files changed, 35 insertions(+), 16 deletions(-)

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 7674498..25501ef 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1614,22 +1614,40 @@ SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 
1, 0, 0,
 SCM
 scm_i_relativize_path (SCM path, SCM in_path)
 {
-  char *str, *canon;
   SCM scanon;
   
-  str = scm_to_locale_string (path);
-  canon = canonicalize_file_name (str);
-  free (str);
-  
-  if (!canon)
-    return SCM_BOOL_F;
+  {
+    char *str, *canon;
 
-  scanon = scm_take_locale_string (canon);
+    str = scm_to_locale_string (path);
+    canon = canonicalize_file_name (str);
+    free (str);
 
+    if (!canon)
+      return SCM_BOOL_F;
+
+    scanon = scm_take_locale_string (canon);
+  }
+  
   for (; scm_is_pair (in_path); in_path = scm_cdr (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
         could set DIR to (getcwd) in that case, but then the
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index dfa430e..ea8eaa7 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -1865,14 +1865,15 @@
       (with-fluids ((%file-port-name-canonicalization 'relative))
         (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"
-    ;; 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))
-          (port-filename
-           (open-input-file (%search-load-path "ice-9/q.scm"))))
-        (throw 'unresolved)))
+    (with-fluids ((%file-port-name-canonicalization 'relative))
+      (port-filename
+       (open-input-file (%search-load-path "ice-9/q.scm")))))
 
   (pass-if-equal "absolute canonicalization from ice-9"
       (canonicalize-path