normalize-pathname prepends unicode prefix,

(normalize-pathname) does not

core/io/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init kernel system namespaces io io.encodings
-io.encodings.utf8 init assocs ;
+io.encodings.utf8 init assocs splitting ;
 IN: io.backend
 
 SYMBOL: io-backend

core/io/files/files-tests.factor

@@ -220,8 +220,6 @@ io.encodings.utf8 ;
 
 [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
-[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test
-[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
 [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
 [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
@@ -239,9 +237,6 @@ io.encodings.utf8 ;
 [ "lib" ] [ "" "lib" append-path ] unit-test
 [ "lib" ] [ "" "./lib" append-path ] unit-test
 
-[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
-[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
-
 [ "foo/bar/." parent-directory ] must-fail
 [ "foo/bar/./" parent-directory ] must-fail
 [ "foo/bar/baz/.." parent-directory ] must-fail
@@ -263,5 +258,4 @@ io.encodings.utf8 ;
 [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
 
 [ t ] [ "resource:core" absolute-path? ] unit-test
-[ t ] [ "/foo" absolute-path? ] unit-test
 [ f ] [ "" absolute-path? ] unit-test

core/io/files/files.factor

@@ -102,6 +102,7 @@ PRIVATE>
 
 : windows-absolute-path? ( path -- path ? )
     {
+        { [ dup "\\\\?\\" head? ] [ t ] }
         { [ dup length 2 < ] [ f ] }
         { [ dup second CHAR: : = ] [ t ] }
         { [ t ] [ f ] }
@@ -111,8 +112,8 @@ PRIVATE>
     {
         { [ dup empty? ] [ f ] }
         { [ dup "resource:" head? ] [ t ] }
-        { [ dup first path-separator? ] [ t ] }
         { [ windows? ] [ windows-absolute-path? ] }
+        { [ dup first path-separator? ] [ t ] }
         { [ t ] [ f ] }
     } cond nip ;
 
@@ -126,6 +127,9 @@ PRIVATE>
             2 tail left-trim-separators
             >r parent-directory r> append-path
         ] }
+        { [ over absolute-path? over first path-separator? and ] [
+            >r 2 head r> append
+        ] }
         { [ t ] [
             >r right-trim-separators "/" r>
             left-trim-separators 3append
@@ -296,14 +300,17 @@ DEFER: copy-tree-into
 : temp-file ( name -- path )
     temp-directory prepend-path ;
 
-M: object normalize-pathname ( path -- path' )
+: (normalize-pathname) ( path -- path' )
     "resource:" ?head [
         left-trim-separators resource-path
-        normalize-pathname
+        (normalize-pathname)
     ] [
         current-directory get prepend-path
     ] if ;
 
+M: object normalize-pathname ( path -- path' )
+    (normalize-pathname) ;
+
 ! Pathname presentations
 TUPLE: pathname string ;
 

extra/editors/editors.factor

@@ -26,7 +26,7 @@ SYMBOL: edit-hook
     require ;
 
 : edit-location ( file line -- )
-    >r normalize-pathname "\\\\?\\" ?head drop r>
+    >r (normalize-pathname) "\\\\?\\" ?head drop r>
     edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
 
 : edit ( defspec -- )

extra/io/unix/files/files-tests.factor

@@ -21,3 +21,9 @@ IN: io.unix.files.tests
 [ "/lib/" ] [ "/" "../lib/" append-path ] unit-test
 [ "/lib" ] [ "/" "../../lib" append-path ] unit-test
 [ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test
+
+{ [ "/lib" ] [ "/usr/" "/lib" append-path ] }
+{ [ "/lib/" ] [ "/usr/" "/lib/" append-path ] }
+{ [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] }
+{ [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] }
+{ [ t ] [ "/foo" absolute-path? ] }

extra/io/windows/launcher/launcher.factor

@@ -28,7 +28,7 @@ TUPLE: CreateProcess-args
     "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
     TRUE >>bInheritHandles
     0 >>dwCreateFlags
-    current-directory get normalize-pathname >>lpCurrentDirectory ;
+    current-directory get (normalize-pathname) >>lpCurrentDirectory ;
 
 : call-CreateProcess ( CreateProcess-args -- )
     {

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

@@ -1,9 +1,9 @@
 USING: io.files kernel tools.test io.backend
-io.windows.nt.files splitting ;
+io.windows.nt.files splitting sequences ;
 IN: io.windows.nt.files.tests
 
-[ t ] [ "\\foo" absolute-path? ] unit-test
+[ f ] [ "\\foo" absolute-path? ] unit-test
-[ t ] [ "\\\\?\\foo" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:" absolute-path? ] unit-test
 
@@ -45,3 +45,6 @@ IN: io.windows.nt.files.tests
     "C:\\builds\\factor\\12345\\"
     "..\\.." append-path normalize-pathname
 ] unit-test
+
+[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
+[ t ] [ "" resource-path 2 tail exists? ] unit-test

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

@@ -36,28 +36,14 @@ ERROR: not-absolute-path ;
     } && [ 2 head ] [ not-absolute-path ] if ;
 
 : prepend-prefix ( string -- string' )
-    unicode-prefix prepend ;
-
-ERROR: nonstring-pathname ;
-ERROR: empty-pathname ;
-
-M: windows-nt-io normalize-pathname ( string -- string )
-    "resource:" ?head [
-        left-trim-separators resource-path
-        normalize-pathname
-    ] [
-        dup empty? [ empty-pathname ] when
-        current-directory get prepend-path
     dup unicode-prefix head? [
-            dup first path-separator? [
-                left-trim-separators
-                current-directory get 2 head
-                prepend-path
-            ] when
         unicode-prefix prepend
-        ] unless
+    ] unless ;
-        { { CHAR: / CHAR: \\ } } substitute ! necessary
+
-    ] if ;
+M: windows-nt-io normalize-pathname ( string -- string' )
+    (normalize-pathname)
+    { { CHAR: / CHAR: \\ } } substitute
+    prepend-prefix ;
 
 M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
     FILE_FLAG_OVERLAPPED bitor ;