More cleanups to require-all and unit tests
parent
c1dd7cf855
commit
9271da5070
|
@ -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
|
||||
|
|
|
@ -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. ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue