From ae623ff9249632872cc85c69ecf3ade2797a47d0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 1 Apr 2008 19:00:20 -0500 Subject: [PATCH] normalize-pathname prepends unicode prefix, (normalize-pathname) does not --- core/io/backend/backend.factor | 2 +- core/io/files/files-tests.factor | 6 ----- core/io/files/files.factor | 13 ++++++--- extra/editors/editors.factor | 2 +- extra/io/unix/files/files-tests.factor | 6 +++++ extra/io/windows/launcher/launcher.factor | 2 +- extra/io/windows/nt/files/files-tests.factor | 9 ++++--- extra/io/windows/nt/files/files.factor | 28 +++++--------------- 8 files changed, 32 insertions(+), 36 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 6bcd448385..935b007dd5 100755 --- a/core/io/backend/backend.factor +++ b/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 diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 9920d8d25c..b4a7d44433 100755 --- a/core/io/files/files-tests.factor +++ b/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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 099acb157e..d2142cc6f3 100755 --- a/core/io/files/files.factor +++ b/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 ; diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index c442dfaa94..00e20de5b5 100755 --- a/extra/editors/editors.factor +++ b/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 -- ) diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index bb2039adfb..a0310a1cac 100755 --- a/extra/io/unix/files/files-tests.factor +++ b/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? ] } diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 31247e43c3..f3226bfbf0 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -28,7 +28,7 @@ TUPLE: CreateProcess-args "PROCESS_INFORMATION" >>lpProcessInformation TRUE >>bInheritHandles 0 >>dwCreateFlags - current-directory get normalize-pathname >>lpCurrentDirectory ; + current-directory get (normalize-pathname) >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor index 73d6a0bf7f..431aced65d 100644 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/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 -[ 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 diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 81112a89c0..bc676b8d0a 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/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 ; + 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 ;