cleanup windows normalize-path

core/io/files/files-tests.factor

@@ -89,6 +89,12 @@ io.encodings.utf8 ;
     ] with-directory
 ] unit-test
 
+[ { { "kernel" t } } ] [
+    "resource:core" [
+        "." directory [ first "kernel" = ] subset
+    ] with-directory
+] unit-test
+
 [ ] [
     "copy-tree-test/a/b/c" temp-file make-directories
 ] unit-test

core/io/files/files.factor

@@ -173,8 +173,12 @@ M: object cwd ( -- path ) "." ;
 [ cwd current-directory set-global ] "current-directory" add-init-hook
 
 : with-directory ( path quot -- )
+    >r normalize-pathname r>
     current-directory swap with-variable ; inline
 
+: set-current-directory ( path -- )
+    normalize-pathname current-directory set ;
+
 ! Creating directories
 HOOK: make-directory io-backend ( path -- )
 

extra/io/windows/nt/files/files-tests.factor

@@ -1,15 +1,47 @@
-USING: kernel tools.test ;
+USING: io.files kernel tools.test io.backend
+io.windows.nt.files splitting ;
 IN: io.windows.nt.files.tests
 
-[ f ] [ "" root-directory? ] unit-test
-[ t ] [ "\\" root-directory? ] unit-test
-[ t ] [ "\\\\" root-directory? ] unit-test
-[ t ] [ "\\\\\\\\\\\\" root-directory? ] unit-test
-[ t ] [ "/" root-directory? ] unit-test
-[ t ] [ "//" root-directory? ] unit-test
-[ t ] [ "//////////////" root-directory? ] unit-test
 [ t ] [ "\\foo" absolute-path? ] unit-test
 [ t ] [ "\\\\?\\foo" absolute-path? ] unit-test
 [ t ] [ "c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:" absolute-path? ] unit-test
 
+[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
+[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
+[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
+! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
+[ "c:\\" ] [ "c:\\" parent-directory ] unit-test
+[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test
+[ "c:" ] [ "c:" parent-directory ] unit-test
+[ "Z:" ] [ "Z:" parent-directory ] unit-test
+
+[ f ] [ "" root-directory? ] unit-test
+[ t ] [ "\\" root-directory? ] unit-test
+[ t ] [ "\\\\" root-directory? ] unit-test
+[ t ] [ "/" root-directory? ] unit-test
+[ t ] [ "//" root-directory? ] unit-test
+[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test
+[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test
+[ f ] [ "c:\\foo" root-directory? ] unit-test
+[ f ] [ "." root-directory? ] unit-test
+[ f ] [ ".." root-directory? ] unit-test
+
+[ ] [ "" resource-path cd ] unit-test
+
+[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test
+
+[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\log.txt" append-path normalize-pathname
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." append-path normalize-pathname
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." append-path normalize-pathname
+] unit-test

extra/io/windows/nt/files/files.factor

@@ -18,12 +18,15 @@ M: windows-nt-io cd
     "\\\\?\\" ; inline
 
 M: windows-nt-io root-directory? ( path -- ? )
-    dup length 2 = [
+    {
-        first2
+        { [ dup empty? ] [ f ] }
-        [ Letter? ] [ CHAR: : = ] bi* and
+        { [ dup [ path-separator? ] all? ] [ t ] }
-    ] [
+        { [ dup right-trim-separators
-        drop f
+          { [ dup length 2 = ] [ dup second CHAR: : = ] } && nip ] [
-    ] if ;
+            t
+        ] }
+        { [ t ] [ f ] }
+    } cond nip ;
 
 ERROR: not-absolute-path ;
 : root-directory ( string -- string' )
@@ -36,45 +39,25 @@ ERROR: not-absolute-path ;
 : prepend-prefix ( string -- string' )
     unicode-prefix prepend ;
 
-: windows-append-path ( cwd path -- newpath )
-    {
-        ! empty
-        { [ dup empty? ] [ drop ] }
-        ! ..
-        { [ dup ".." = ] [ drop parent-directory prepend-prefix ] }
-        ! \\\\?\\c:\\foo
-        { [ dup unicode-prefix head? ] [ nip ] }
-        ! ..\\foo
-        { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-append-path ] }
-        ! .\\foo
-        { [ dup ".\\" head? ] [ 1 tail append prepend-prefix ] }
-        ! \\foo
-        { [ dup "\\" head? ] [ >r root-directory r> append prepend-prefix ] }
-        ! c:\\foo
-        { [ dup ?second CHAR: : = ] [ nip prepend-prefix ] }
-        ! foo.txt
-        { [ t ] [
-            >r right-trim-separators "\\" r>
-            left-trim-separators
-            3append prepend-prefix
-        ] }
-    } cond ;
-
 ERROR: nonstring-pathname ;
 ERROR: empty-pathname ;
 
-USE: tools.walker
 M: windows-nt-io normalize-pathname ( string -- string )
     "resource:" ?head [
         left-trim-separators resource-path
         normalize-pathname
     ] [
-        dup string? [ nonstring-pathname ] unless
         dup empty? [ empty-pathname ] when
-        { { CHAR: / CHAR: \\ } } substitute
+        current-directory get prepend-path
-        current-directory get swap windows-append-path
+        dup unicode-prefix head? [
-        [ "/\\." member? ] right-trim
+            dup first path-separator? [
-        dup peek CHAR: : = [ "\\" append ] when
+                left-trim-separators
+                current-directory get 2 head
+                prepend-path
+            ] when
+            unicode-prefix prepend
+        ] unless
+        { { CHAR: / CHAR: \\ } } substitute ! necessary
     ] if ;
 
 M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )