~ chicken-core (chicken-5) d1d093f027c8c1d0953bf6df6431a8340a5dc5d4

commit d1d093f027c8c1d0953bf6df6431a8340a5dc5d4
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:11:01 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 00a26ed8..0ecc9d2a 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))