More work on unit test tool

basis/tools/errors/errors.factor

@@ -16,7 +16,7 @@ IN: tools.errors
     ] assoc-each ;
 
 : compiler-errors. ( type -- )
-    errors-of-type errors. ;
+    errors-of-type values errors. ;
 
 : :errors ( -- ) +error+ compiler-errors. ;
 

basis/tools/test/test-docs.factor

@@ -3,13 +3,13 @@ IN: tools.test
 
 ARTICLE: "tools.test.write" "Writing unit tests"
 "Assert that a quotation outputs a specific set of values:"
-{ $subsection unit-test }
+{ $subsection POSTPONE: unit-test }
 "Assert that a quotation throws an error:"
-{ $subsection must-fail }
+{ $subsection POSTPONE: must-fail }
-{ $subsection must-fail-with }
+{ $subsection POSTPONE: must-fail-with }
 "Assert that a quotation or word has a specific static stack effect (see " { $link "inference" } "):"
-{ $subsection must-infer }
+{ $subsection POSTPONE: must-infer }
-{ $subsection must-infer-as } ;
+{ $subsection POSTPONE: must-infer-as } ;
 
 ARTICLE: "tools.test.run" "Running unit tests"
 "The following words run test harness files; any test failures are collected and printed at the end:"
@@ -29,7 +29,7 @@ $nl
 { $subsection run-tests }
 { $subsection run-all-tests }
 "The following word prints failures:"
-{ $subsection test-failures. } ;
+{ $subsection results. } ;
 
 ARTICLE: "tools.test" "Unit testing"
 "A unit test is a piece of code which starts with known input values, then compares the output of a word with an expected output, where the expected output is defined by the word's contract."
@@ -89,6 +89,6 @@ HELP: run-all-tests
 { $values { "failures" "an association list of unit test failures" } }
 { $description "Runs unit tests for all loaded vocabularies and outputs unit test failures as documented in " { $link "tools.test.failure" } "." } ;
 
-HELP: test-failures.
+HELP: results.
 { $values { "assoc" "an association list of unit test failures" } }
 { $description "Prints unit test failures output by " { $link run-tests } " or " { $link run-all-tests } " to " { $link output-stream } "." } ;

basis/tools/test/test.factor

@@ -45,7 +45,8 @@ SYMBOL: failed-tests
     word/quot dup word? [ '[ _ execute ] ] when :> quot
     [ quot infer drop f f ] [ t ] recover ; inline
 
-SINGLETON: did-not-fail
+TUPLE: did-not-fail ;
+CONSTANT: did-not-fail T{ did-not-fail }
 
 M: did-not-fail summary drop "Did not fail" ;
 
@@ -130,7 +131,7 @@ M: test-failure error. ( error -- )
             [ length # " tests failed, " % ]
             [ length # " tests passed." % ]
             bi*
-        ] "" make print nl
+        ] "" make nl print nl
     ] [ drop errors. ] 2bi ;
 
 : run-tests ( prefix -- failed passed )

basis/ui/tools/compiler-errors/compiler-errors.factor

@@ -3,13 +3,13 @@
 USING: accessors arrays sequences sorting assocs colors.constants
 combinators combinators.smart combinators.short-circuit editors
 compiler.errors compiler.units fonts kernel io.pathnames
-stack-checker.errors math.parser math.order models models.arrow
+stack-checker.errors source-files.errors math.parser math.order models
-models.search debugger namespaces summary locals ui ui.commands
+models.arrow models.search debugger namespaces summary locals ui
-ui.gadgets ui.gadgets.panes ui.gadgets.tables ui.gadgets.labeled
+ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.tables
-ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser
+ui.gadgets.labeled ui.gadgets.tracks ui.gestures ui.operations
-ui.tools.common ui.gadgets.scrollers ui.tools.inspector
+ui.tools.browser ui.tools.common ui.gadgets.scrollers
-ui.gadgets.status-bar ui.operations ui.gadgets.buttons
+ui.tools.inspector ui.gadgets.status-bar ui.operations
-ui.gadgets.borders ui.images ;
+ui.gadgets.buttons ui.gadgets.borders ui.images ;
 IN: ui.tools.compiler-errors
 
 TUPLE: error-list-gadget < tool source-file error source-file-table error-table error-display ;
@@ -30,7 +30,7 @@ M: source-file-renderer column-alignment drop { 0 1 } ;
 M: source-file-renderer filled-column drop 0 ;
 
 : <source-file-model> ( model -- model' )
-    [ group-by-source-file >alist sort-keys f prefix ] <arrow> ;
+    [ values group-by-source-file >alist sort-keys f prefix ] <arrow> ;
 
 :: <source-file-table> ( error-list -- table )
     error-list model>> <source-file-model>
@@ -53,16 +53,13 @@ GENERIC: error-icon ( error -- icon )
 : <error-icon> ( name -- image-name )
     "vocab:ui/tools/error-list/icons/" ".tiff" surround <image-name> ;
 
-M: inference-error error-icon
+M: compiler-error error-icon
-    type>> {
+    compiler-error-type {
         { +error+ [ "compiler-error" ] }
         { +warning+ [ "compiler-warning" ] }
+        { +linkage+ [ "linkage-error" ] }
     } case <error-icon> ;
 
-M: object error-icon drop "HAI" ;
-
-M: compiler-error error-icon error>> error-icon ;
-
 M: error-renderer row-columns
     drop [
         {

core/source-files/errors/errors.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math.order sorting ;
+USING: accessors assocs kernel math.order sorting sequences ;
 IN: source-files.errors
 
 TUPLE: source-file-error error file line# ;
 
-: sort-errors ( assoc -- alist )
+: sort-errors ( errors -- alerrors'ist )
     [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
 
 : group-by-source-file ( errors -- assoc )
-    H{ } clone [ [ push-at ] curry [ nip dup file>> ] prepose assoc-each ] keep ;
+    H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;