load-all now skips vocabs tagged 'not loaded', and test-all skips vocabs tagged 'not tested'
parent
da6bcbedfc
commit
7524007110
|
@ -2,11 +2,12 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs combinators compiler.units
|
USING: accessors arrays assocs combinators compiler.units
|
||||||
continuations debugger effects fry generalizations io io.files
|
continuations debugger effects fry generalizations io io.files
|
||||||
io.styles kernel lexer locals macros math.parser namespaces parser
|
io.styles kernel lexer locals macros math.parser namespaces
|
||||||
vocabs.parser prettyprint quotations sequences source-files splitting
|
parser vocabs.parser prettyprint quotations sequences
|
||||||
stack-checker summary unicode.case vectors vocabs vocabs.loader
|
source-files splitting stack-checker summary unicode.case
|
||||||
vocabs.files words tools.errors source-files.errors io.streams.string
|
vectors vocabs vocabs.loader vocabs.files vocabs.metadata words
|
||||||
make compiler.errors ;
|
tools.errors source-files.errors io.streams.string make
|
||||||
|
compiler.errors ;
|
||||||
IN: tools.test
|
IN: tools.test
|
||||||
|
|
||||||
TUPLE: test-failure < source-file-error continuation ;
|
TUPLE: test-failure < source-file-error continuation ;
|
||||||
|
@ -126,7 +127,7 @@ SYMBOL: forget-tests?
|
||||||
forget-tests? get
|
forget-tests? get
|
||||||
[ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
|
[ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
|
||||||
|
|
||||||
: run-vocab-tests ( vocab -- )
|
: test-vocab ( vocab -- )
|
||||||
vocab dup [
|
vocab dup [
|
||||||
dup source-loaded?>> [
|
dup source-loaded?>> [
|
||||||
vocab-tests
|
vocab-tests
|
||||||
|
@ -136,6 +137,8 @@ SYMBOL: forget-tests?
|
||||||
] [ drop ] if
|
] [ drop ] if
|
||||||
] [ drop ] if ;
|
] [ drop ] if ;
|
||||||
|
|
||||||
|
: test-vocabs ( vocabs -- ) [ test-vocab ] each ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
TEST: unit-test
|
TEST: unit-test
|
||||||
|
@ -154,7 +157,6 @@ M: test-failure error. ( error -- )
|
||||||
|
|
||||||
: :test-failures ( -- ) test-failures get errors. ;
|
: :test-failures ( -- ) test-failures get errors. ;
|
||||||
|
|
||||||
: test ( prefix -- )
|
: test ( prefix -- ) child-vocabs test-vocabs ;
|
||||||
child-vocabs [ run-vocab-tests ] each ;
|
|
||||||
|
|
||||||
: test-all ( -- ) "" test ;
|
: test-all ( -- ) vocabs filter-don't-test test-vocabs ;
|
||||||
|
|
|
@ -97,9 +97,6 @@ MEMO: all-vocabs-recursive ( -- assoc )
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: filter-unportable ( seq -- seq' )
|
|
||||||
[ vocab-name unportable? not ] filter ;
|
|
||||||
|
|
||||||
: collect-vocabs ( quot -- seq )
|
: collect-vocabs ( quot -- seq )
|
||||||
[ all-vocabs-recursive no-roots no-prefixes ] dip
|
[ all-vocabs-recursive no-roots no-prefixes ] dip
|
||||||
gather natural-sort ; inline
|
gather natural-sort ; inline
|
||||||
|
@ -109,7 +106,7 @@ PRIVATE>
|
||||||
: (load) ( prefix -- failures )
|
: (load) ( prefix -- failures )
|
||||||
[ child-vocabs-recursive no-roots no-prefixes ]
|
[ child-vocabs-recursive no-roots no-prefixes ]
|
||||||
[ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi
|
[ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi
|
||||||
filter-unportable
|
filter-don't-load
|
||||||
require-all ;
|
require-all ;
|
||||||
|
|
||||||
: load ( prefix -- )
|
: load ( prefix -- )
|
||||||
|
|
|
@ -103,12 +103,21 @@ ERROR: bad-platform name ;
|
||||||
: supported-platform? ( platforms -- ? )
|
: supported-platform? ( platforms -- ? )
|
||||||
[ t ] [ [ os swap class<= ] any? ] if-empty ;
|
[ t ] [ [ os swap class<= ] any? ] if-empty ;
|
||||||
|
|
||||||
: unportable? ( vocab -- ? )
|
: don't-load? ( vocab -- ? )
|
||||||
{
|
{
|
||||||
[ vocab-tags "untested" swap member? ]
|
[ vocab-tags "not loaded" swap member? ]
|
||||||
[ vocab-platforms supported-platform? not ]
|
[ vocab-platforms supported-platform? not ]
|
||||||
} 1|| ;
|
} 1|| ;
|
||||||
|
|
||||||
|
: filter-don't-load ( vocabs -- vocabs' )
|
||||||
|
[ vocab-name don't-load? not ] filter ;
|
||||||
|
|
||||||
|
: don't-test? ( vocab -- ? )
|
||||||
|
vocab-tags "not tested" swap member? ;
|
||||||
|
|
||||||
|
: filter-don't-test ( vocabs -- vocabs' )
|
||||||
|
[ don't-test? not ] filter ;
|
||||||
|
|
||||||
TUPLE: unsupported-platform vocab requires ;
|
TUPLE: unsupported-platform vocab requires ;
|
||||||
|
|
||||||
: unsupported-platform ( vocab requires -- )
|
: unsupported-platform ( vocab requires -- )
|
||||||
|
|
Loading…
Reference in New Issue