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

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

db4
Slava Pestov 2008-03-27 16:24:48 -05:00
parent af28c3376d b6818e75f4
commit 2c5f9ce6ca
4 changed files with 69 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/io/files/files-tests.factor
View File

@ -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

4
core/io/files/files.factor
View File

@ -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 -- )

48
extra/io/windows/nt/files/files-tests.factor
View File

@ -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

55
extra/io/windows/nt/files/files.factor
View File

@ -18,12 +18,15 @@ M: windows-nt-io cd
"\\\\?\\" ; inline
M: windows-nt-io root-directory? ( path -- ? )
dup length 2 = [
first2
[ Letter? ] [ CHAR: : = ] bi* and
] [
drop f
] if ;
{
{ [ dup empty? ] [ f ] }
{ [ dup [ path-separator? ] all? ] [ t ] }
{ [ dup right-trim-separators
{ [ dup length 2 = ] [ dup second CHAR: : = ] } && nip ] [
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 swap windows-append-path
[ "/\\." member? ] right-trim
dup peek CHAR: : = [ "\\" append ] 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
{ { CHAR: / CHAR: \\ } } substitute ! necessary
] if ;
M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )