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

tools.test: adding a warning for possible long unit tests. 

This will help us learn which tests are the slowest on Travis.
fix-linux
John Benediktsson 2019-12-08 09:06:55 -08:00
parent 4350bcbfcd
commit 8e8c62a2d9
1 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
basis/tools/test/test.factor
View File

@ -3,11 +3,12 @@
USING: accessors arrays assocs combinators command-line USING: accessors arrays assocs combinators command-line
compiler.units continuations debugger effects fry compiler.units continuations debugger effects fry
generalizations io io.files.temp io.files.unique kernel lexer generalizations io io.files.temp io.files.unique kernel lexer
locals macros math.functions math.vectors namespaces parser locals macros math math.functions math.vectors namespaces parser
prettyprint quotations sequences sequences.generalizations prettyprint quotations sequences sequences.generalizations
source-files source-files.errors source-files.errors.debugger source-files source-files.errors source-files.errors.debugger
splitting stack-checker summary system tools.errors unicode splitting stack-checker summary system tools.errors tools.time
vocabs vocabs.files vocabs.metadata vocabs.parser words ; unicode vocabs vocabs.files vocabs.metadata vocabs.parser words
;
FROM: vocabs.hierarchy => load ; FROM: vocabs.hierarchy => load ;
IN: tools.test IN: tools.test
@ -46,6 +47,9 @@ t restartable-tests? set-global
swap >>error swap >>error
error-continuation get >>continuation ; error-continuation get >>continuation ;
SYMBOL: long-unit-tests-threshold
long-unit-tests-threshold [ 10,000,000,000 ] initialize
SYMBOL: long-unit-tests-enabled? SYMBOL: long-unit-tests-enabled?
long-unit-tests-enabled? [ t ] initialize long-unit-tests-enabled? [ t ] initialize
@ -167,15 +171,26 @@ 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 ;
: possible-long-unit-tests ( vocab nanos -- )
long-unit-tests-threshold get [
dupd > long-unit-tests-enabled? get not and [
swap
"Warning: possible long unit test for " write
vocab-name write " - " write
1,000,000,000 /f pprint " seconds" print
] [ 2drop ] if
] [ 2drop ] if* ;
: test-vocab ( vocab -- ) : test-vocab ( vocab -- )
lookup-vocab dup [ lookup-vocab [
dup source-loaded?>> [ dup source-loaded?>> [
vocab-tests dup vocab-tests [
[ [ run-test-file ] each ] [ [ run-test-file ] each ]
[ forget-tests ] [ forget-tests ]
bi bi
] benchmark possible-long-unit-tests
] [ drop ] if ] [ drop ] if
] [ drop ] if ; ] when* ;
: test-vocabs ( vocabs -- ) [ test-vocab ] each ; : test-vocabs ( vocabs -- ) [ test-vocab ] each ;