~ chicken-core (chicken-5) b95f4c46b6e5d82609acdaa5e2f5cad7fc4ceaf3

commit b95f4c46b6e5d82609acdaa5e2f5cad7fc4ceaf3
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Sep 22 06:51:52 2014 +1200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Oct 9 20:58:27 2014 +0200

    Make normalize-pathname take pathnames with no parts to just "/" or "."
    
    Previously, it would unnecessarily append a dot or slash if the
    normalized path was equivalent to "/" or ".", respectively.
    
    Fixes #1153.

diff --git a/NEWS b/NEWS
index 58f7f5b3..e44d32c6 100644
--- a/NEWS
+++ b/NEWS
@@ -20,6 +20,8 @@
   - Removed deprecated implicit expansion of $VAR- and ~ in pathnames.
      The ~-expansion functionality is now available in the
      "pathname-expand" egg (#1001, #1079) (thanks to Florian Zumbiehl).
+  - normalize-pathname has been simplified to avoid adding trailing
+     slashes or dots (#1153, thanks to Michele La Monaca and Mario Goulart).
 
 - Unit lolevel:
   - Restore long-lost but still documented "vector-like?" procedure (#983)
diff --git a/files.scm b/files.scm
index bc8b4e4f..6b935736 100644
--- a/files.scm
+++ b/files.scm
@@ -370,9 +370,7 @@ EOF
 		   (when (fx> i prev)
 		     (set! parts (addpart (##sys#substring path prev i) parts)))
 		   (if (null? parts)
-		       (let ((r (if abspath
-				    (##sys#string-append (string sep) ".")
-				    (##sys#string-append "." (string sep)) )))
+		       (let ((r (if abspath (string sep) ".")))
 			 (if drive
 			     (##sys#string-append drive r)
 			     r))
diff --git a/tests/path-tests.scm b/tests/path-tests.scm
index 4e22205b..1af196b6 100644
--- a/tests/path-tests.scm
+++ b/tests/path-tests.scm
@@ -22,14 +22,15 @@
 (test "q/abc" (pathname-directory "q/abc/.def.ghi"))
 (test "q/abc" (pathname-directory "q/abc/.ghi"))
 
-(test "./" (normalize-pathname "" 'unix))
-(test ".\\" (normalize-pathname "" 'windows))
+(test "." (normalize-pathname "" 'unix))
+(test "." (normalize-pathname "" 'windows))
 (test "\\..\\" (normalize-pathname "/../" 'windows))
-(test "\\." (normalize-pathname "/abc/../." 'windows))
-(test "/." (normalize-pathname "/" 'unix))
-(test "/." (normalize-pathname "/./" 'unix))
-(test "/." (normalize-pathname "/." 'unix))
-(test "./" (normalize-pathname "./" 'unix))
+(test "\\" (normalize-pathname "/abc/../." 'windows))
+(test "/" (normalize-pathname "/" 'unix))
+(test "/" (normalize-pathname "/." 'unix))
+(test "/" (normalize-pathname "/./" 'unix))
+(test "/" (normalize-pathname "/./." 'unix))
+(test "." (normalize-pathname "./" 'unix))
 (test "a" (normalize-pathname "a"))
 (test "a/" (normalize-pathname "a/" 'unix))
 (test "a/b" (normalize-pathname "a/b" 'unix))
@@ -50,7 +51,10 @@
 (test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
 (test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
 (test "../../foo" (normalize-pathname "../../foo" 'unix))
-(test "c:\\." (normalize-pathname "c:\\" 'windows))
+(test "c:\\" (normalize-pathname "c:\\" 'windows))
+(test "c:\\" (normalize-pathname "c:\\." 'windows))
+(test "c:\\" (normalize-pathname "c:\\.\\" 'windows))
+(test "c:\\" (normalize-pathname "c:\\.\\." 'windows))
 
 (test "~/foo" (normalize-pathname "~/foo" 'unix))
 (test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
@@ -61,10 +65,11 @@
 (assert (not (directory-null? "//foo//")))
 
 (test '(#f "/" (".")) (receive (decompose-directory "/.//")))
-(test '(#f "\\" (".")) (receive (decompose-directory (normalize-pathname "/.//" 'windows))))
 (test '(#f "/" #f) (receive (decompose-directory "///\\///")))
 (test '(#f "/" ("foo")) (receive (decompose-directory "//foo//")))
 (test '(#f "/" ("foo" "bar")) (receive (decompose-directory "//foo//bar")))
+(test '(#f #f (".")) (receive (decompose-directory ".//")))
+(test '(#f #f ("." "foo")) (receive (decompose-directory ".//foo//")))
 (test '(#f #f (" " "foo" "bar")) (receive (decompose-directory " //foo//bar")))
 (test '(#f #f ("foo" "bar")) (receive (decompose-directory "foo//bar/")))