>From a83a7bdc26ab18f37aa86203e3980e7d7268ea10 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Mon, 22 Sep 2014 06:51:52 +1200 Subject: [PATCH] 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. --- files.scm | 4 +--- tests/path-tests.scm | 23 ++++++++++++++--------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/files.scm b/files.scm index bc8b4e4..6b93573 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 4e22205..1af196b 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/"))) -- 1.7.10.4