Cleanup vocab name validation. Vocab names and vocab prefixes are the same concept...

diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor
index 947209b2d9288d13e9f0a834b75b5cb8d15ba843..2a3b0f1a6cc99223c375f09a428f00e21d6d3549 100644 (file)
--- a/basis/vocabs/hierarchy/hierarchy.factor
+++ b/basis/vocabs/hierarchy/hierarchy.factor
@@ -34,7 +34,7 @@ ERROR: vocab-root-required root ;
     dup vocab-roots get member? [ vocab-root-required ] unless ;\r
 \r
 : ensure-vocab-root/prefix ( root prefix -- root prefix )\r
-    [ ensure-vocab-root ] [ forbid-absolute-path ] bi* ;\r
+    [ ensure-vocab-root ] [ check-vocab-name ] bi* ;\r
 \r
 : (child-vocabs) ( root prefix -- vocabs )\r
     ensure-vocab-root/prefix\r

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 20c71e06ddf06eec7d9fe18da677a88b48ad7f62..1b2fc0cc5415af744aaca6ac837431d0d92a916b 100644 (file)
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -45,13 +45,8 @@ PRIVATE>
 : vocab-dir ( vocab -- dir )
     vocab-name { { CHAR: . CHAR: / } } substitute ;
 
-ERROR: absolute-path-forbidden path ;
-
-: forbid-absolute-path ( str -- str )
-    dup absolute-path? [ absolute-path-forbidden ] when ;
-
 : append-vocab-dir ( vocab str/f -- path )
-    [ vocab-name forbid-absolute-path "." split ] dip
+    [ vocab-name "." split ] dip
     [ [ dup last ] dip append suffix ] when*
     "/" join ;
 

diff --git a/core/vocabs/vocabs-tests.factor b/core/vocabs/vocabs-tests.factor
index 18e6b3710181154e194823bfe2812d17d65c0c76..a7421b89c9b8ce243d667f5037078556c7fe1848 100644 (file)
--- a/core/vocabs/vocabs-tests.factor
+++ b/core/vocabs/vocabs-tests.factor
@@ -8,3 +8,24 @@ IN: vocabs.tests
 [ t ] [ "" "io.files" child-vocab? ] unit-test
 [ t ] [ "io" "io.files" child-vocab? ] unit-test
 [ f ] [ "io.files" "io" child-vocab? ] unit-test
+
+[ "foo/bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo\\bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo:bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
+[ 3 create-vocab ] [ bad-vocab-name? ] must-fail-with
+[ f create-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "a b" create-vocab ] [ bad-vocab-name? ] must-fail-with
+
+[ "foo/bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo\\bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo:bar" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ 3 lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ f lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "a b" lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+
+[ "foo/bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo\\bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "foo:bar" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ 3 >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ f >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with
+[ "a b" >vocab-link lookup-vocab ] [ bad-vocab-name? ] must-fail-with

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index 1b7a84b03d05912984e16a33d917c71f48227c31..746b5d5606d47601dde1d4c8540e3e960ee9b0d6 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -21,6 +21,12 @@ SYMBOL: +done+
         swap >>name
         H{ } clone >>words ;
 
+ERROR: bad-vocab-name name ;
+
+: check-vocab-name ( name -- name )
+    dup string? [ bad-vocab-name ] unless
+    dup ":/\\ " intersects? [ bad-vocab-name ] when ;
+
 TUPLE: vocab-link name ;
 
 C: <vocab-link> vocab-link
@@ -33,7 +39,7 @@ M: vocab vocab-name name>> ;
 
 M: vocab-link vocab-name name>> ;
 
-M: string vocab-name ;
+M: object vocab-name check-vocab-name ;
 
 GENERIC: lookup-vocab ( vocab-spec -- vocab )
 
@@ -78,11 +84,6 @@ GENERIC: vocabs-changed ( obj -- )
 : notify-vocab-observers ( -- )
     vocab-observers get [ vocabs-changed ] each ;
 
-ERROR: bad-vocab-name name ;
-
-: check-vocab-name ( name -- name )
-    dup string? [ bad-vocab-name ] unless ;
-
 : create-vocab ( name -- vocab )
     check-vocab-name
     dictionary get [ <vocab> ] cache
@@ -115,7 +116,7 @@ GENERIC: >vocab-link ( name -- vocab )
 
 M: vocab-spec >vocab-link ;
 
-M: string >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
+M: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
 
 : forget-vocab ( vocab -- )
     [ words forget-all ]