\\?\c: is a root-directory on windows

diff --git a/basis/io/windows/nt/files/files-tests.factor b/basis/io/windows/nt/files/files-tests.factor
index 830861eba095ddcbb8b54893d93c785dc94001a3..6620dd691eb71856f6a78e37698b12b0131ab262 100755 (executable)
--- a/basis/io/windows/nt/files/files-tests.factor
+++ b/basis/io/windows/nt/files/files-tests.factor
@@ -4,8 +4,12 @@ IN: io.windows.nt.files.tests
 
 [ f ] [ "\\foo" absolute-path? ] unit-test
 [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test
 [ t ] [ "c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:" absolute-path? ] unit-test
+[ t ] [ "c:\\" absolute-path? ] unit-test
+[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test
 
 [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
 [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
@@ -26,6 +30,9 @@ IN: io.windows.nt.files.tests
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test
+[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test
+[ t ] [ "\\\\?\\c:" root-directory? ] unit-test
+[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test
 
 [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
 

diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor
index b572d9ec65e9dd485e82fe8052238cf5a9aad534..157662ade8bfdb9e5b13360cfffc6eb2e73d8438 100755 (executable)
--- a/basis/io/windows/nt/files/files.factor
+++ b/basis/io/windows/nt/files/files.factor
@@ -20,11 +20,14 @@ M: winnt cd
 
 M: winnt root-directory? ( path -- ? )
     {
-        { [ dup empty? ] [ f ] }
-        { [ dup [ path-separator? ] all? ] [ t ] }
-        { [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] }
-        [ f ]
-    } cond nip ;
+        { [ dup empty? ] [ drop f ] }
+        { [ dup [ path-separator? ] all? ] [ drop t ] }
+        { [ dup trim-right-separators { [ length 2 = ]
+          [ second CHAR: : = ] } 1&& ] [ drop t ] }
+        { [ dup unicode-prefix head? ]
+          [ trim-right-separators length unicode-prefix length 2 + = ] }
+        [ drop f ]
+    } cond ;
 
 ERROR: not-absolute-path ;