diff --git a/basis/tools/coverage/coverage-docs.factor b/basis/tools/coverage/coverage-docs.factor index fcae9ae156..ffee62874e 100644 --- a/basis/tools/coverage/coverage-docs.factor +++ b/basis/tools/coverage/coverage-docs.factor @@ -32,23 +32,11 @@ HELP: coverage { $description "Outputs a sequence of quotations that were not called since coverage tracking was enabled. If the input is a string, the output is an alist of word-name/quotations that were not used. If the input is a word name, the output is a sequence of quotations." } ; HELP: coverage-off -{ $values - { "object" object } -} { $description "Deactivates the coverage tool on a word or vocabulary and its private vocabulary." } ; HELP: coverage-on -{ $values - { "object" object } -} { $description "Activates the coverage tool on a word or vocabulary and its private vocabulary." } ; -HELP: toggle-coverage -{ $values - { "object" object } -} -{ $description "Toggles whether the coverage tool is active on a word or vocabulary and its private vocabulary." } ; - HELP: coverage. { $values { "object" object } @@ -62,12 +50,57 @@ HELP: %coverage } { $description "Returns a fraction representing the number of quotations called compared to the number of quotations that exist in a vocabulary or word." } ; +HELP: add-coverage +{ $values + { "object" object } +} +{ $description "Recompiles a vocabulary with the coverage annotation. Note that the annotation tool is still disabled until you call " { $link coverage-on } "." } ; + +HELP: covered +{ $values + { "value" object } +} +{ $description "The value that determines whether coverage will set the " { $snippet "executed?" } " slot when code runs." } ; + +HELP: flag-covered +{ $values + { "coverage" object } +} +{ $description "A word that sets the " { $snippet "executed?" } " slot of the coverage tuple when the covered value is true." } ; + +HELP: remove-coverage +{ $values + { "object" object } +} +{ $description "Recompiles a vocabulary without the coverage annotation." } ; + +HELP: reset-coverage +{ $values + { "object" object } +} +{ $description "Sets the " { $snippet "execute?" } " slot of each coverage tuple to false." } ; + +HELP: test-coverage +{ $values + { "vocab" "a vocabulary specifier" } + { "coverage" sequence } +} +{ $description "Enables code coverage for a vocabulary and activates it for the unit tests only. The returned value is a sequence of pairs containing names and quotations which did not execute." } ; + ARTICLE: "tools.coverage" "Coverage tool" "The " { $vocab-link "tools.coverage" } " vocabulary is a tool for testing code coverage. The implementation uses " { $vocab-link "tools.annotations" } " to place a coverage object at the beginning of every quotation. When the quotation executes, a slot on the coverage object is set to true. By examining the coverage objects after running the code for some time, one can see which of the quotations did not execute and write more tests or refactor the code." $nl +"An example of using the coverage tool by hand would be to call " { $link add-coverage } " and then call " { $link coverage-on } ". Next, run whatever code you think will call the most quotations in the code you're testing, and then run the " { $link coverage. } " word on your vocabulary to see which quotations didn't get run." $nl +"A fully automated way to test the unit-test coverage of a vocabulary is the " { $link test-coverage } " word." $nl +"Adding coverage annotations to a vocabulary:" +{ $subsections add-coverage remove-coverage } +"Resetting coverage annotations:" +{ $subsections reset-coverage } "Enabling/disabling coverage:" -{ $subsections coverage-on coverage-off toggle-coverage } +{ $subsections coverage-on coverage-off } "Examining coverage data:" { $subsections coverage coverage. %coverage } +"Gather unit-test coverage data for a vocabulary:" +{ $subsections test-coverage } "Combinators for iterating over words in a vocabulary:" { $subsections each-word map-words } ; diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor index 98f9476d0e..7fa34d59e8 100644 --- a/basis/tools/coverage/coverage.factor +++ b/basis/tools/coverage/coverage.factor @@ -3,16 +3,28 @@ USING: accessors assocs fry io kernel math prettyprint quotations sequences sequences.deep splitting strings tools.annotations vocabs words arrays words.symbol -combinators.short-circuit ; +combinators.short-circuit values tools.test +combinators continuations ; IN: tools.coverage TUPLE: coverage < identity-tuple executed? ; C: coverage -GENERIC: coverage-on ( object -- ) +VALUE: covered -GENERIC: coverage-off ( object -- ) +: flag-covered ( coverage -- ) + covered [ t >>executed? ] when drop ; + +: coverage-on ( -- ) t \ covered set-value ; + +: coverage-off ( -- ) f \ covered set-value ; + +GENERIC: add-coverage ( object -- ) + +GENERIC: remove-coverage ( object -- ) + +GENERIC: reset-coverage ( object -- ) [ [ coverage-words ] dip map ] 2bi append ] if ; inline -M: string coverage-on - [ coverage-on ] each-word ; +M: string add-coverage + [ add-coverage ] each-word ; -M: string coverage-off ( vocabulary -- ) - [ coverage-off ] each-word ; +M: string remove-coverage + [ remove-coverage ] each-word ; -M: word coverage-on ( word -- ) +M: word add-coverage H{ } clone [ "coverage" set-word-prop ] 2keep '[ \ coverage new [ _ set-at ] 2keep - '[ _ t >>executed? drop ] prepend + '[ _ flag-covered ] prepend ] deep-annotate ; -M: word coverage-off ( word -- ) +M: word remove-coverage [ reset ] [ f "coverage" set-word-prop ] bi ; -GENERIC: toggle-coverage ( object -- ) +M: string reset-coverage + [ reset-coverage ] each-word ; -M: string toggle-coverage - [ toggle-coverage ] each-word ; - -M: word toggle-coverage - dup "coverage" word-prop [ - coverage-off - ] [ - coverage-on - ] if ; +M: word reset-coverage + [ dup coverage? [ f >>executed? ] when drop ] each-word ; GENERIC: coverage ( object -- seq ) @@ -82,13 +88,19 @@ GENERIC: coverage. ( object -- ) M: string coverage. [ coverage. ] each-word ; -M: word coverage. - dup coverage [ - drop +: pair-coverage. ( word quots -- ) + dup empty? [ + 2drop ] [ [ name>> ":" append print ] [ [ " " write . ] each ] bi* - ] if-empty ; + ] if ; + +M: word coverage. + dup coverage pair-coverage. ; + +M: sequence coverage. + [ first2 pair-coverage. ] each ; +: test-coverage ( vocab -- coverage ) + [ + add-coverage + ] [ + dup '[ + [ + _ + [ coverage-on test coverage-off ] + [ coverage ] bi + ] [ _ remove-coverage ] [ ] cleanup + ] call + ] bi ; + : %coverage ( string -- x ) [ coverage values concat length ] [ count-callables ] bi [ swap - ] keep /f ; inline