! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.units
continuations debugger effects fry generalizations io io.files
-io.styles kernel lexer locals macros math.parser namespaces parser
-vocabs.parser prettyprint quotations sequences source-files splitting
-stack-checker summary unicode.case vectors vocabs vocabs.loader
-vocabs.files words tools.errors source-files.errors io.streams.string
-make compiler.errors ;
+io.styles kernel lexer locals macros math.parser namespaces
+parser vocabs.parser prettyprint quotations sequences
+source-files splitting stack-checker summary unicode.case
+vectors vocabs vocabs.loader vocabs.files vocabs.metadata words
+tools.errors source-files.errors io.streams.string make
+compiler.errors ;
IN: tools.test
TUPLE: test-failure < source-file-error continuation ;
forget-tests? get
[ [ [ forget-source ] each ] with-compilation-unit ] [ drop ] if ;
-: run-vocab-tests ( vocab -- )
+: test-vocab ( vocab -- )
vocab dup [
dup source-loaded?>> [
vocab-tests
] [ drop ] if
] [ drop ] if ;
+: test-vocabs ( vocabs -- ) [ test-vocab ] each ;
+
PRIVATE>
TEST: unit-test
: :test-failures ( -- ) test-failures get errors. ;
-: test ( prefix -- )
- child-vocabs [ run-vocab-tests ] each ;
+: test ( prefix -- ) child-vocabs test-vocabs ;
-: test-all ( -- ) "" test ;
+: test-all ( -- ) vocabs filter-don't-test test-vocabs ;
\r
<PRIVATE\r
\r
-: filter-unportable ( seq -- seq' )\r
- [ vocab-name unportable? not ] filter ;\r
-\r
: collect-vocabs ( quot -- seq )\r
[ all-vocabs-recursive no-roots no-prefixes ] dip\r
gather natural-sort ; inline\r
: (load) ( prefix -- failures )\r
[ child-vocabs-recursive no-roots no-prefixes ]\r
[ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi\r
- filter-unportable\r
+ filter-don't-load\r
require-all ;\r
\r
: load ( prefix -- )\r
: supported-platform? ( platforms -- ? )
[ 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 ]
} 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 ;
: unsupported-platform ( vocab requires -- )