diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index e42dace945..352ef9fe02 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -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 diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index d761df35d2..09d497aac7 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -11,7 +11,8 @@ SYMBOL: failures : ( error what -- triple ) error-continuation get 3array ; -: failure ( error what -- ) failures get push ; +: failure ( error what -- ) + 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 . + 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. ;