From c062c24ead6fdcc88338abfc4ee738c731f678a9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 27 Aug 2011 00:56:02 -0500
Subject: [PATCH] Add toggle-coverage word and make coverage-on/off work on
.private vocabs too.
---
basis/tools/coverage/coverage-docs.factor | 12 +++++++---
basis/tools/coverage/coverage.factor | 29 ++++++++++++++++++++---
2 files changed, 35 insertions(+), 6 deletions(-)
diff --git a/basis/tools/coverage/coverage-docs.factor b/basis/tools/coverage/coverage-docs.factor
index b2f52c2e9a..764939aac9 100644
--- a/basis/tools/coverage/coverage-docs.factor
+++ b/basis/tools/coverage/coverage-docs.factor
@@ -21,13 +21,19 @@ HELP: coverage-off
{ $values
{ "object" object }
}
-{ $description "Deactivates the coverage tool on a word or vocabulary." } ;
+{ $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." } ;
+{ $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
@@ -38,7 +44,7 @@ HELP: coverage.
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
"Enabling/disabling coverage:"
-{ $subsections coverage-on coverage-off }
+{ $subsections coverage-on coverage-off toggle-coverage }
"Examining coverage data:"
{ $subsections coverage coverage. } ;
diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor
index 62be43ea47..0e04d904ea 100644
--- a/basis/tools/coverage/coverage.factor
+++ b/basis/tools/coverage/coverage.factor
@@ -1,22 +1,33 @@
! Copyright (C) 2011 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry kernel quotations sequences strings
-tools.annotations vocabs words prettyprint io ;
+tools.annotations vocabs words prettyprint io splitting ;
IN: tools.coverage
TUPLE: coverage < identity-tuple executed? ;
C: <coverage> coverage
+: private-vocab-name ( string -- string' )
+ ".private" ?tail drop ".private" append ;
+
GENERIC: coverage-on ( object -- )
GENERIC: coverage-off ( object -- )
+: change-coverage ( string quot -- )
+ over ".private" tail? [
+ [ words ] dip each
+ ] [
+ [ [ private-vocab-name words ] dip each ]
+ [ [ words ] dip each ] 2bi
+ ] if ; inline
+
M: string coverage-on
- words [ coverage-on ] each ;
+ [ coverage-on ] change-coverage ;
M: string coverage-off ( vocabulary -- )
- words [ coverage-off ] each ;
+ [ coverage-off ] change-coverage ;
M: word coverage-on ( word -- )
H{ } clone [ "coverage" set-word-prop ] 2keep
@@ -28,6 +39,18 @@ M: word coverage-on ( word -- )
M: word coverage-off ( word -- )
[ reset ] [ f "coverage" set-word-prop ] bi ;
+GENERIC: toggle-coverage ( object -- )
+
+M: string toggle-coverage
+ words [ toggle-coverage ] each ;
+
+M: word toggle-coverage
+ dup "coverage" word-prop [
+ coverage-off
+ ] [
+ coverage-on
+ ] if ;
+
GENERIC: coverage ( object -- seq )
M: string coverage