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> [
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
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 436bf8598d..60943be48c 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 ] "io.files" 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 )