More work on unit test tool
parent
af8f98495d
commit
e467f4eea3
|
@ -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. ;
|
||||
|
||||
|
|
|
@ -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 must-fail-with }
|
||||
{ $subsection POSTPONE: must-fail }
|
||||
{ $subsection POSTPONE: must-fail-with }
|
||||
"Assert that a quotation or word has a specific static stack effect (see " { $link "inference" } "):"
|
||||
{ $subsection must-infer }
|
||||
{ $subsection must-infer-as } ;
|
||||
{ $subsection POSTPONE: must-infer }
|
||||
{ $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 } "." } ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
models.search debugger namespaces summary locals ui ui.commands
|
||||
ui.gadgets ui.gadgets.panes ui.gadgets.tables ui.gadgets.labeled
|
||||
ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser
|
||||
ui.tools.common ui.gadgets.scrollers ui.tools.inspector
|
||||
ui.gadgets.status-bar ui.operations ui.gadgets.buttons
|
||||
ui.gadgets.borders ui.images ;
|
||||
stack-checker.errors source-files.errors math.parser math.order models
|
||||
models.arrow models.search debugger namespaces summary locals ui
|
||||
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.tables
|
||||
ui.gadgets.labeled ui.gadgets.tracks ui.gestures ui.operations
|
||||
ui.tools.browser ui.tools.common ui.gadgets.scrollers
|
||||
ui.tools.inspector ui.gadgets.status-bar ui.operations
|
||||
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
|
||||
type>> {
|
||||
M: compiler-error error-icon
|
||||
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 [
|
||||
{
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue