Merge git://factorcode.org/git/factor

core/io/files/files.factor

@@ -29,12 +29,15 @@ HOOK: root-directory? io-backend ( path -- ? )
 
 M: object root-directory? ( path -- ? ) path-separator? ;
 
-: trim-path-separators ( str -- newstr )
+: right-trim-separators ( str -- newstr )
     [ path-separator? ] right-trim ;
 
+: left-trim-separators ( str -- newstr )
+    [ path-separator? ] left-trim ;
+
 : path+ ( str1 str2 -- str )
-    >r trim-path-separators "/" r>
+    >r right-trim-separators "/" r>
-    [ path-separator? ] left-trim 3append ;
+    left-trim-separators 3append ;
 
 : stat ( path -- directory? permissions length modified )
     normalize-pathname (stat) ;
@@ -69,7 +72,7 @@ TUPLE: no-parent-directory path ;
     \ no-parent-directory construct-boa throw ;
 
 : parent-directory ( path -- parent )
-    trim-path-separators {
+    right-trim-separators {
         { [ dup empty? ] [ drop "/" ] }
         { [ dup root-directory? ] [ ] }
         { [ dup [ path-separator? ] contains? not ] [ drop "." ] }
@@ -90,7 +93,7 @@ TUPLE: no-parent-directory path ;
     "resource:" ?head [ resource-path ] when ;
 
 : make-directories ( path -- )
-    normalize-pathname trim-path-separators {
+    normalize-pathname right-trim-separators {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }

core/vocabs/loader/loader-docs.factor

@@ -124,7 +124,7 @@ HELP: refresh
 { $values { "prefix" string } }
 { $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
 
-HELP: refresh-all-error
+HELP: require-all-error
 { $values { "vocabs" "a sequence of vocabularies" } }
 { $description "Throws a " { $link require-all-error } "." }
 { $error-description "Thrown by " { $link require-all } " if one or more vocabulary failed to load." } ;

core/vocabs/loader/loader.factor

@@ -149,7 +149,7 @@ SYMBOL: load-help?
     dup modified-sources swap modified-docs ;
 
 : load-error. ( vocab error -- )
-    "While loading " swap dup >vocab-link write-object ":" print
+    "While loading " rot dup >vocab-link write-object ":" print
     print-error ;
 
 TUPLE: require-all-error vocabs ;

extra/io/windows/nt/files/files.factor

@@ -37,11 +37,13 @@ M: windows-nt-io root-directory? ( path -- ? )
 : windows-path+ ( cwd path -- newpath )
     {
         ! empty
-        { [ dup empty? ] [ "empty path" throw ] }
+        { [ dup empty? ] [ drop ] }
+        ! ..
+        { [ dup ".." = ] [ drop parent-directory prepend-prefix ] }
         ! \\\\?\\c:\\foo
         { [ dup unicode-prefix head? ] [ nip ] }
         ! ..\\foo
-        { [ dup "..\\" head? ] [ >r parent-directory r> 2 tail windows-path+ ] }
+        { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-path+ ] }
         ! .\\foo
         { [ dup ".\\" head? ] [ 1 tail append prepend-prefix ] }
         ! \\foo
@@ -49,7 +51,11 @@ M: windows-nt-io root-directory? ( path -- ? )
         ! c:\\foo
         { [ dup ?second CHAR: : = ] [ nip prepend-prefix ] }
         ! foo.txt
-        { [ t ] [ [ first CHAR: \\ = "" "\\" ? ] keep 3append prepend-prefix ] }
+        { [ t ] [
+            >r right-trim-separators "\\" r>
+            left-trim-separators
+            3append prepend-prefix
+        ] }
     } cond ;
 
 M: windows-nt-io normalize-pathname ( string -- string )

extra/io/windows/nt/nt-tests.factor

@@ -1,4 +1,5 @@
-USING: io.files kernel tools.test io.backend splitting ;
+USING: io.files kernel tools.test io.backend
+io.windows.nt.files splitting ;
 IN: temporary
 
 [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
@@ -9,8 +10,8 @@ IN: temporary
 [ "Z:" ] [ "Z:\\" parent-directory ] unit-test
 [ "c:" ] [ "c:" parent-directory ] unit-test
 [ "Z:" ] [ "Z:" parent-directory ] unit-test
-[ t ] [ "c:\\" trim-path-separators root-directory? ] unit-test
+[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" trim-path-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
@@ -18,3 +19,18 @@ IN: temporary
 [ ] [ "" 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" windows-path+
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." windows-path+
+] unit-test
+
+[ "\\\\?\\C:\\builds\\" ] [
+    "C:\\builds\\factor\\12345\\"
+    "..\\.." windows-path+
+] unit-test