normalize-pathname prepends unicode prefix,

(normalize-pathname) does not
db4
Doug Coleman 2008-04-01 19:00:20 -05:00
parent a80e95ac2d
commit ae623ff924
8 changed files with 32 additions and 36 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -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? ] }

View File

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

View File

@ -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
[ t ] [ "\\\\?\\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
@ -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

View File

@ -36,28 +36,14 @@ ERROR: not-absolute-path ;
} && [ 2 head ] [ not-absolute-path ] if ;
: prepend-prefix ( string -- string' )
unicode-prefix prepend ;
dup unicode-prefix head? [
unicode-prefix prepend
] unless ;
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
{ { 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 ;