From b6818e75f492f89d8fcb8f156fba5a339876763b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 16:22:24 -0500 Subject: [PATCH 1/2] cleanup windows normalize-path --- core/io/files/files-tests.factor | 6 +++ core/io/files/files.factor | 4 ++ extra/io/windows/nt/files/files-tests.factor | 48 ++++++++++++++--- extra/io/windows/nt/files/files.factor | 55 +++++++------------- 4 files changed, 69 insertions(+), 44 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 9af82a5672..b732495541 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f6888bf78d..3ebde42b96 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -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 -- ) diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor index 3b31d73e4a..73d6a0bf7f 100644 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/extra/io/windows/nt/files/files-tests.factor @@ -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 diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index c6cbf292b3..24111346b6 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -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 ) From af28c3376d1e151578cb4e2bcb9dcaf3d94903c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 16:24:38 -0500 Subject: [PATCH 2/2] Fix PowerPC intrinsic --- core/cpu/ppc/intrinsics/intrinsics.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 8a2f41ec12..0aef15ba99 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -481,7 +481,7 @@ IN: cpu.ppc.intrinsics \ [ tuple "layout" get layout-size 2 + cells %allot ! Store layout - "layout" operand 12 LOAD32 + "layout" get 12 load-indirect 12 11 cell STW ! Zero out the rest of the tuple f v>operand 12 LI