60 lines
1.4 KiB
Factor
60 lines
1.4 KiB
Factor
! Copyright (C) 2003, 2007 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: errors namespaces arrays prettyprint io sequences kernel
|
|
vectors quotations words parser tools assocs ;
|
|
IN: test
|
|
|
|
SYMBOL: failures
|
|
|
|
: <failure> ( error what -- triple )
|
|
error-continuation get 3array ;
|
|
|
|
SYMBOL: this-test
|
|
|
|
: (unit-test) ( what quot -- )
|
|
swap dup . flush this-test set
|
|
[ time ] curry failures get [
|
|
[
|
|
this-test get <failure> failures get push
|
|
] recover
|
|
] [
|
|
call
|
|
] if ;
|
|
|
|
: unit-test ( output input -- )
|
|
[ 2array ] 2keep [
|
|
V{ } swap with-datastack swap >vector assert=
|
|
] curry curry (unit-test) ;
|
|
|
|
TUPLE: expected-error ;
|
|
|
|
: unit-test-fails ( quot -- )
|
|
[ f ] append [ [ drop t ] recover ] curry
|
|
[ t ] swap unit-test ;
|
|
|
|
: run-test ( path -- failures )
|
|
[
|
|
"temporary" forget-vocab
|
|
V{ } clone failures set
|
|
[ run-file { } ] [ swap <failure> 1array ] recover
|
|
failures get append
|
|
] with-scope ;
|
|
|
|
: failure. ( triple -- )
|
|
dup second .
|
|
dup first error.
|
|
"Traceback" swap third write-object ;
|
|
|
|
: failures. ( path failures -- )
|
|
"Failing tests in " write swap <pathname> .
|
|
[ nl failure. nl ] each ;
|
|
|
|
: run-tests ( seq -- )
|
|
[ dup run-test ] { } map>assoc
|
|
[ second empty? not ] subset
|
|
dup empty? [ drop ] [
|
|
nl
|
|
"==== FAILING TESTS:" print
|
|
[ nl failures. ] assoc-each
|
|
] if ;
|