More cleanups to require-all and unit tests

db4
Slava Pestov 2008-02-06 22:12:44 -06:00
parent c1dd7cf855
commit 9271da5070
2 changed files with 39 additions and 28 deletions

View File

@ -148,10 +148,17 @@ SYMBOL: load-help?
dup update-roots
dup modified-sources swap modified-docs ;
: load-error. ( vocab error -- )
"==== " write >r
dup vocab-name swap f >vocab-link write-object ":" print nl
r> print-error ;
: vocab-heading. ( vocab -- )
nl
"==== " write
dup vocab-name swap f >vocab-link write-object ":" print
nl ;
: load-error. ( triple -- )
dup first vocab-heading.
dup second print-error
drop ;
! third "Traceback" swap write-object ;
TUPLE: require-all-error vocabs ;
@ -166,10 +173,14 @@ M: require-all-error summary
dup length 1 = [ first require ] [
[
[
[ [ require ] [ 2array , ] recover ] each
[
[ require ]
[ error-continuation get 3array , ]
recover
] each
] { } make
dup empty? [ drop ] [
dup [ nl load-error. ] assoc-each
dup [ load-error. nl ] each
keys require-all-error
] if
] with-compiler-errors

View File

@ -11,7 +11,8 @@ SYMBOL: failures
: <failure> ( error what -- triple )
error-continuation get 3array ;
: failure ( error what -- ) <failure> failures get push ;
: failure ( error what -- )
<failure> failures get push ;
SYMBOL: this-test
@ -45,16 +46,23 @@ M: expected-error summary
: ignore-errors ( quot -- )
[ drop ] recover ; inline
: run-test ( path -- failures )
[ "temporary" forget-vocab ] with-compilation-unit
[
V{ } clone [
failures [
[ run-file ] [ swap failure ] recover
] with-variable
] keep
] keep
[ forget-source ] with-compilation-unit ;
: (run-test) ( vocab -- )
dup vocab-source-loaded? [
vocab-tests-path dup [
dup ?resource-path exists? [
[ "temporary" forget-vocab ] with-compilation-unit
dup run-file
[ dup forget-source ] with-compilation-unit
] when
] when
] when drop ;
: run-test ( vocab -- failures )
V{ } clone [
failures [
(run-test)
] with-variable
] keep ;
: failure. ( triple -- )
dup second .
@ -70,8 +78,7 @@ M: expected-error summary
] [
"==== FAILING TESTS:" print
[
nl
"Failing tests in " write swap <pathname> .
swap vocab-heading.
[ nl failure. nl ] each
] assoc-each
] if
@ -79,19 +86,12 @@ M: expected-error summary
drop "==== NOTHING TO TEST" print
] if ;
: run-vocab-tests ( vocabs -- failures )
dup empty? [ f ] [
: run-tests ( prefix -- failures )
child-vocabs dup empty? [ f ] [
[ dup run-test ] { } map>assoc
[ second empty? not ] subset
] if ;
: run-tests ( prefix -- failures )
child-vocabs
[ vocab-source-loaded? ] subset
[ vocab-tests-path ] map
[ dup [ ?resource-path exists? ] when ] subset
run-vocab-tests ;
: test ( prefix -- )
run-tests failures. ;