steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

Slava Pestov 2008-09-18 18:20:32 -05:00
parent 58914da662 772a964a04
commit c545bc4b53
2 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/io/windows/nt/files/files-tests.factor
View File

@ -4,8 +4,12 @@ IN: io.windows.nt.files.tests
[ f ] [ "\\foo" absolute-path? ] unit-test [ f ] [ "\\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
[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test
[ t ] [ "c:\\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:\\" absolute-path? ] unit-test
[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test
[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] 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
@ -26,6 +30,9 @@ IN: io.windows.nt.files.tests
[ f ] [ "c:\\foo" root-directory? ] unit-test [ f ] [ "c:\\foo" root-directory? ] unit-test
[ f ] [ "." root-directory? ] unit-test [ f ] [ "." 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 [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test

13
basis/io/windows/nt/files/files.factor
View File

@ -20,11 +20,14 @@ M: winnt cd
M: winnt root-directory? ( path -- ? ) M: winnt root-directory? ( path -- ? )
{ {
{ [ dup empty? ] [ f ] } { [ dup empty? ] [ drop f ] }
{ [ dup [ path-separator? ] all? ] [ t ] } { [ dup [ path-separator? ] all? ] [ drop t ] }
{ [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] } { [ dup trim-right-separators { [ length 2 = ]
[ f ] [ second CHAR: : = ] } 1&& ] [ drop t ] }
} cond nip ; { [ dup unicode-prefix head? ]
[ trim-right-separators length unicode-prefix length 2 + = ] }
[ drop f ]
} cond ;
ERROR: not-absolute-path ; ERROR: not-absolute-path ;