Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor
index f23a1ac1f4f9856ea876d6b59baeae8aee8a6f76..38cfe330fb513cdcc6083e35671993aed077cc73 100644 (file)
--- a/core/io/pathnames/pathnames-tests.factor
+++ b/core/io/pathnames/pathnames-tests.factor
@@ -1,6 +1,6 @@
 USING: io.pathnames io.files.temp io.directories
 continuations math io.files.private kernel
-namespaces tools.test io.pathnames.private ;
+namespaces sequences tools.test io.pathnames.private ;
 IN: io.pathnames.tests
 
 [ "passwd" ] [ "/etc/passwd" file-name ] unit-test
@@ -11,20 +11,23 @@ IN: io.pathnames.tests
 [ "freetype6.dll" ] [ "resource:freetype6.dll" file-name ] unit-test
 [ "freetype6.dll" ] [ "resource:/freetype6.dll" file-name ] unit-test
 
-[ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
-[ "/usr/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
-[ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test
+: >test-path ( path -- path' )
+    [ dup path-separator? [ drop CHAR: / ] when ] map ;
+
+[ "/usr/lib" ] [ "/usr" "lib" append-path >test-path ] unit-test
+[ "/usr/lib" ] [ "/usr/" "lib" append-path >test-path ] unit-test
+[ "/usr/lib" ] [ "/usr" "./lib" append-path >test-path ] unit-test
+[ "/usr/lib/" ] [ "/usr" "./lib/" append-path >test-path ] unit-test
+[ "/lib" ] [ "/usr" "../lib" append-path >test-path ] unit-test
+[ "/lib/" ] [ "/usr" "../lib/" append-path >test-path ] unit-test
 
 [ "" ] [ "" "." append-path ] unit-test
 [ "" ".." append-path ] must-fail
 
-[ "/" ] [ "/" "./." append-path ] unit-test
-[ "/" ] [ "/" "././" append-path ] unit-test
-[ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
-[ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
+[ "/" ] [ "/" "./." append-path >test-path ] unit-test
+[ "/" ] [ "/" "././" append-path >test-path ] unit-test
+[ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path >test-path ] unit-test
+[ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path >test-path ] unit-test
 
 [ "" "../lib/" append-path ] must-fail
 [ "lib" ] [ "" "lib" append-path ] unit-test
@@ -45,10 +48,10 @@ IN: io.pathnames.tests
 [ "" parent-directory ] must-fail
 [ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
 
-[ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
-[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
-[ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test
-[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
+[ "bar/foo" ] [ "bar/baz" "..///foo" append-path >test-path ] unit-test
+[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path >test-path ] unit-test
+[ "bar/foo" ] [ "bar/baz" "./..//foo" append-path >test-path ] unit-test
+[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path >test-path ] unit-test
 
 [ t ] [ "resource:core" absolute-path? ] unit-test
 [ f ] [ "" absolute-path? ] unit-test
@@ -61,7 +64,7 @@ IN: io.pathnames.tests
     "." current-directory set
     ".." "resource-path" set
     [ "../core/bootstrap/stage2.factor" ]
-    [ "resource:core/bootstrap/stage2.factor" absolute-path ]
+    [ "resource:core/bootstrap/stage2.factor" absolute-path >test-path ]
     unit-test
 ] with-scope
 

diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor
index b307128efb2287bbd60d9a36ffa7866aac42ab9b..2be66ef1861068a94f1fa59fc05ae25a847288b7 100644 (file)
--- a/core/io/pathnames/pathnames.factor
+++ b/core/io/pathnames/pathnames.factor
@@ -76,6 +76,8 @@ ERROR: no-parent-directory path ;
         [ f ]
     } cond ;
 
+PRIVATE>
+
 : absolute-path? ( path -- ? )
     {
         { [ dup empty? ] [ f ] }
@@ -85,8 +87,6 @@ ERROR: no-parent-directory path ;
         [ f ]
     } cond nip ;
 
-PRIVATE>
-
 : append-path ( path1 path2 -- path )
     {
         { [ over empty? ] [ append-path-empty ] }
@@ -103,7 +103,7 @@ PRIVATE>
         ] }
         [
             [ trim-tail-separators ]
-            [ trim-head-separators ] bi* "/" glue
+            [ trim-head-separators ] bi* path-separator glue
         ]
     } cond ;
 

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 2c0f67641d15ef897aa1372b74b2f64dc8949f95..390cfceb9554a19d09d7ffce28ca437132c4e0f3 100644 (file)
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -35,12 +35,14 @@ M: string vocab-path ( string -- path/f )
 PRIVATE>
 
 : vocab-dir ( vocab -- dir )
-    vocab-name { { CHAR: . CHAR: / } } substitute ;
+    vocab-name
+    os windows? { { CHAR: . CHAR: \\ } } { { CHAR: . CHAR: / } } ?
+    substitute ;
 
 : vocab-dir+ ( vocab str/f -- path )
     [ vocab-name "." split ] dip
     [ [ dup last ] dip append suffix ] when*
-    "/" join ;
+    path-separator join ;
 
 : find-vocab-root ( vocab -- path/f )
     vocab-name dup root-cache get at