~ chicken-core (chicken-5) cde395398877f1ec984e3a38f8bd810926f23be2

commit cde395398877f1ec984e3a38f8bd810926f23be2
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jul 21 22:19:45 2015 +1200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Wed Jul 22 15:00:55 2015 +0200

    Fix normalize-pathname for dot-relative paths beginning with ".//"
    
    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.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index 8eb4e48e..bb9d1fce 100644
--- a/NEWS
+++ b/NEWS
@@ -35,6 +35,10 @@
 - Unit lolevel:
   - Restore long-lost but still documented "vector-like?" procedure (#983)
 
+- Unit "files":
+  - normalize-pathname no longer considers paths starting with ".//"
+    as absolute (#1202, reported by Haochi Kiang).
+
 - Unit "posix":
   - set-file-position! now allows negative positions for seek/cur (thanks
     to Seth Alves).
diff --git a/files.scm b/files.scm
index af437d1a..59de9610 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 1af196b6..6e66fa66 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))