steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanup vocab name validation. Vocab names and vocab prefixes are the same concept, and by disallowing slashes, spaces, and colon, we automatically check for absolute paths. Unit test this.

db4
Doug Coleman 2011-10-28 23:39:40 -07:00
parent 21787e285c
commit aa7f22edc0
4 changed files with 31 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/vocabs/hierarchy/hierarchy.factor
View File

@ -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

7
core/vocabs/loader/loader.factor
View File

@ -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 ;

21
core/vocabs/vocabs-tests.factor
View File

@ -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

15
core/vocabs/vocabs.factor
View File

@ -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 ]