]> gitweb.factorcode.org Git - factor.git/commitdiff
io.pathnames: Allow vocab: to find paths that do not exist as long as the vocab exists.
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 6 Jan 2022 05:21:02 +0000 (23:21 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 6 Jan 2022 05:30:06 +0000 (23:30 -0600)
`"benchmark/sum-file/sum-file.txt" vocab-path` can now reference a file
in a vocab.

Add `has-path-extension?` word which ensures a path is not a
directory (does not end in / or any path-separator), and if
that's the case then it is true if there's a dot in the file name.

The cases we check in vocab-path (triggered with vocab:)
- if path ends in /, we assume it must be a vocab that exists
-- you can't create a vocab that doesn't exist with vocab:foo syntax
because there the root is ambiguous

- if path has extension, we assume it's a file name and allow it
to look up if the parent vocabulary exists

- finally we just try the current behavior, e.g. the vocab has
to exist

Added a lot of tests, please file bugs if you disagree!

Fixes #592.

core/io/pathnames/pathnames-tests.factor
core/io/pathnames/pathnames.factor
core/vocabs/loader/loader.factor

index 8f90de142e9ccc1f8aac4d32c68c19442f6c0dfc..b21de3050be03d6bf1edc7556220ac915e970711 100644 (file)
@@ -1,6 +1,5 @@
-USING: io.backend io.directories io.files.private io.files.temp
-io.files.unique io.pathnames kernel locals math multiline
-namespaces sequences system tools.test ;
+USING: io.backend io.directories io.files.private io.pathnames
+kernel math namespaces sequences system tools.test vocabs.loader ;
 
 { "passwd" } [ "/etc/passwd" file-name ] unit-test
 { "awk" } [ "/usr/libexec/awk/" file-name ] unit-test
@@ -157,4 +156,32 @@ os windows? [
     { "/" } [ "/Users/foo/bar////././." root-path ] unit-test
     { "/" } [ "/Users/foo/bar////.//../../../../../../////./." root-path ] unit-test
     { "/" } [ "/Users/////" root-path ] unit-test
-] if
\ No newline at end of file
+] if
+
+{ t } [ "." has-file-extension? ] unit-test
+{ t } [ ".." has-file-extension? ] unit-test
+{ t } [ "a.b" has-file-extension? ] unit-test
+{ f } [ "a/" has-file-extension? ] unit-test
+{ f } [ "a.b/" has-file-extension? ] unit-test
+{ t } [ "math.factor" has-file-extension? ] unit-test
+{ t } [ "math." has-file-extension? ] unit-test
+{ f } [ "math" has-file-extension? ] unit-test
+
+{ "resource:core/math" } [ "math" vocab-path ] unit-test
+{ "resource:core/math/" } [ "math/" vocab-path ] unit-test
+
+[ "math.omg" vocab-path ] [ not-found-in-roots? ] must-fail-with
+[ "math.omg/" vocab-path ] [ not-found-in-roots? ] must-fail-with
+[ "accessors" vocab-path ] [ not-found-in-roots? ] must-fail-with
+[ "asdfasdfasdfasfd1231231" vocab-path ] [ not-found-in-roots? ] must-fail-with
+[ "resource:extra/benchmark/sum-file/sum-file.txt/" vocab-path ]
+[ not-found-in-roots? ] must-fail-with
+
+{ "resource:extra/benchmark/sum-file/sum-file.txt" }
+[ "benchmark/sum-file/sum-file.txt" vocab-path ] unit-test
+
+{ "resource:extra/benchmark/sum-file" }
+[ "benchmark/sum-file" vocab-path ] unit-test
+
+{ "resource:extra/benchmark/sum-file/" }
+[ "benchmark/sum-file/" vocab-path ] unit-test
\ No newline at end of file
index 5433b4594dd08165694cb534778a33b66eb1def2..64bc3f762a73304dfb5a59bcc8d47550560e742a 100644 (file)
@@ -128,6 +128,11 @@ PRIVATE>
 : file-extension ( path -- extension )
     file-name "." split1-last nip ;
 
+: has-file-extension? ( path -- ? )
+    dup ?last path-separator?
+    [ drop f ]
+    [ file-name CHAR: . swap member? ] if ;
+
 : path-components ( path -- seq )
     normalize-path path-separator split harvest ;
 
index 0ab6ed154af0c1e1aa4daa3dc58f6c4fa2545beb..a9e6fde666efba65e7c5b610be2e4b8f909a6a75 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs continuations definitions init
-io io.files io.pathnames kernel make namespaces parser
-sequences sets splitting strings vocabs words ;
+USING: accessors arrays assocs combinators continuations
+definitions init io io.files io.pathnames kernel make namespaces
+parser sequences sets splitting strings vocabs words ;
 IN: vocabs.loader
 
 SYMBOL: vocab-roots
@@ -36,9 +36,24 @@ ERROR: not-found-in-roots path ;
 : find-root-for ( path -- path/f )
     vocab-roots get [ prepend-path file-exists? ] with find nip ;
 
-M: string vocab-path
+: find-root-for-vocab-pathname ( path -- path/f )
     dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
 
+: ensure-parent-directory-is-not-dot ( path -- parent-directory )
+    dup parent-directory dup "." =
+    [ drop not-found-in-roots ]
+    [ nip ] if ;
+
+M: string vocab-path
+    {
+        { [ dup ?last path-separator? ] [ find-root-for-vocab-pathname ] }
+        { [ dup has-file-extension? ] [
+            [ ensure-parent-directory-is-not-dot find-root-for-vocab-pathname ]
+            [ file-name ] bi append-path
+        ] }
+        [ find-root-for-vocab-pathname ]
+    } cond ;
+
 PRIVATE>
 
 : vocab-dir ( vocab -- dir )