diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor index 947209b2d9..2a3b0f1a6c 100644 --- 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 ; : ensure-vocab-root/prefix ( root prefix -- root prefix ) - [ ensure-vocab-root ] [ forbid-absolute-path ] bi* ; + [ ensure-vocab-root ] [ check-vocab-name ] bi* ; : (child-vocabs) ( root prefix -- vocabs ) ensure-vocab-root/prefix diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 20c71e06dd..1b2fc0cc54 100644 --- 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 18e6b37101..a7421b89c9 100644 --- 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 1b7a84b03d..746b5d5606 100644 --- 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 @@ -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 [ ] cache @@ -115,7 +116,7 @@ GENERIC: >vocab-link ( name -- vocab ) M: vocab-spec >vocab-link ; -M: string >vocab-link dup lookup-vocab [ ] [ ] ?if ; +M: object >vocab-link dup lookup-vocab [ ] [ ] ?if ; : forget-vocab ( vocab -- ) [ words forget-all ]