[Chicken-hackers] [PATCH] Fix normalize-pathname for dot-relative paths beginning with ".//"

[Evan Hanson]

Because dots aren't pushed onto the accumulated list of pathname parts,
`normalize-pathname` would hit the second slash, see that there were no
leading parts, and consider the path absolute.

To fix this, we make the function save the type of the path, either
'abs(olute) or 'rel(ative), as soon as it's known, and avoid overwriting
it from then on.

Fixes #1202.
---
 files.scm            | 22 ++++++++++------------
 tests/path-tests.scm |  2 ++
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/files.scm b/files.scm
index af437d1..59de961 100644
--- a/files.scm
+++ b/files.scm
@@ -363,17 +363,15 @@ EOF
       (let ((sep (if (eq? platform 'windows) #\\ #\/)))
        (##sys#check-string path 'normalize-pathname)
        (let ((len (##sys#size path))
-             (abspath #f)
+             (type #f)
              (drive #f))
          (let loop ((i 0) (prev 0) (parts '()))
            (cond ((fx>= i len)
                   (when (fx> i prev)
                     (set! parts (addpart (##sys#substring path prev i) parts)))
                   (if (null? parts)
-                      (let ((r (if abspath (string sep) ".")))
-                        (if drive
-                            (##sys#string-append drive r)
-                            r))
+                      (let ((r (if (eq? type 'abs) (string sep) ".")))
+                        (if drive (##sys#string-append drive r) r))
                       (let ((out (open-output-string))
                             (parts (##sys#fast-reverse parts)))
                         (display (car parts) out)
@@ -384,14 +382,14 @@ EOF
                          (cdr parts))
                         (when (fx= i prev) (##sys#write-char-0 sep out))
                         (let ((r (get-output-string out)))
-                           (when abspath
-                             (set! r (##sys#string-append (string sep) r)))
-                           (when drive
-                             (set! r (##sys#string-append drive r)))
-                           r))))
+                          (when (eq? type 'abs)
+                            (set! r (##sys#string-append (string sep) r)))
+                          (when drive
+                            (set! r (##sys#string-append drive r)))
+                          r))))
                  ((*char-pds? (string-ref path i))
-                  (when (and (null? parts) (fx= i prev))
-                    (set! abspath #t))
+                  (when (not type)
+                    (set! type (if (fx= i prev) 'abs 'rel)))
                   (if (fx= i prev)
                       (loop (fx+ i 1) (fx+ i 1) parts)
                       (loop (fx+ i 1)
diff --git a/tests/path-tests.scm b/tests/path-tests.scm
index 1af196b..6e66fa6 100644
--- a/tests/path-tests.scm
+++ b/tests/path-tests.scm
@@ -31,6 +31,8 @@
 (test "/" (normalize-pathname "/./" 'unix))
 (test "/" (normalize-pathname "/./." 'unix))
 (test "." (normalize-pathname "./" 'unix))
+(test "a" (normalize-pathname "./a"))
+(test "a" (normalize-pathname ".///a"))
 (test "a" (normalize-pathname "a"))
 (test "a/" (normalize-pathname "a/" 'unix))
 (test "a/b" (normalize-pathname "a/b" 'unix))
-- 
2.1.4