More cleanups to require-all and unit tests

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 -- )
+: vocab-heading. ( vocab -- )
-    "==== " write >r
+    nl
-    dup vocab-name swap f >vocab-link write-object ":" print nl
+    "==== " write
-    r> print-error ;
+    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

extra/tools/test/test.factor

@@ -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 )
+: (run-test) ( vocab -- )
-    [ "temporary" forget-vocab ] with-compilation-unit
+    dup vocab-source-loaded? [
-    [
+        vocab-tests-path dup [
-        V{ } clone [
+            dup ?resource-path exists? [
-            failures [
+                [ "temporary" forget-vocab ] with-compilation-unit
-                [ run-file ] [ swap failure ] recover
+                dup run-file
-            ] with-variable
+                [ dup forget-source ] with-compilation-unit
-        ] keep
+            ] when
-    ] keep
+        ] when
-    [ forget-source ] with-compilation-unit ;
+    ] 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
+                swap vocab-heading.
-                "Failing tests in " write swap <pathname> .
                 [ 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 )
+: run-tests ( prefix -- failures )
-    dup empty? [ f ] [
+    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. ;