Merge remote-tracking branch 'erg/master'

diff --git a/basis/tools/coverage/coverage-docs.factor b/basis/tools/coverage/coverage-docs.factor
index 2964abb51c0faf48a5cc53a3b1c4f1dd2a6f1853..fcae9ae156b7854d73e674785f8f7f1bce74b01e 100644 (file)
--- a/basis/tools/coverage/coverage-docs.factor
+++ b/basis/tools/coverage/coverage-docs.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel sequences ;
+USING: alien.c-types help.markup help.syntax kernel quotations
+sequences strings ;
 IN: tools.coverage
 
 HELP: <coverage>
@@ -8,7 +9,20 @@ HELP: <coverage>
     { "executed?" boolean }
     { "coverage" coverage }
 }
-{ $description "Makes a coverage tuple. Users should not call this directly." } ;
+{ $description "Makes a coverage tuple. Users should not call this directly." } ; 
+
+HELP: each-word
+{ $values
+    { "string" string } { "quot" quotation }    
+}
+{ $description "Calls a quotation on every word in the vocabulary and its private vocabulary, if there is one." } ;
+
+HELP: map-words
+{ $values
+    { "string" string } { "quot" quotation }
+    { "sequence" sequence }
+}
+{ $description "Calls a quotation on every word in the vocabulary and its private vocabulary, if there is one, and collects the results." } ;
 
 HELP: coverage
 { $values
@@ -21,13 +35,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
@@ -35,11 +55,20 @@ HELP: coverage.
 }
 { $description "Calls the coverage word on all the words in a vocabalary or on a single word and prints out a report." } ;
 
-ARTICLE: "tools.coverage" "tools.coverage"
+HELP: %coverage
+{ $values
+    { "string" string }
+    { "x" double }
+}
+{ $description "Returns a fraction representing the number of quotations called compared to the number of quotations that exist in a vocabulary or word." } ;
+
+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. } ;
+{ $subsections coverage coverage. %coverage }
+"Combinators for iterating over words in a vocabulary:"
+{ $subsections each-word map-words } ;
 
 ABOUT: "tools.coverage"

diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor
index 62be43ea475caa339796bff3d84720c56366162d..98f9476d0e708d7d323328a17bc6cd587cbc4dcf 100644 (file)
--- a/basis/tools/coverage/coverage.factor
+++ b/basis/tools/coverage/coverage.factor
@@ -1,7 +1,9 @@
 ! 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 ;
+USING: accessors assocs fry io kernel math prettyprint
+quotations sequences sequences.deep splitting strings
+tools.annotations vocabs words arrays words.symbol
+combinators.short-circuit ;
 IN: tools.coverage
 
 TUPLE: coverage < identity-tuple executed? ;
@@ -12,26 +14,64 @@ GENERIC: coverage-on ( object -- )
 
 GENERIC: coverage-off ( object -- )
 
+<PRIVATE
+
+: private-vocab-name ( string -- string' )
+    ".private" ?tail drop ".private" append ;
+
+: coverage-words ( string -- words )
+    words [ { [ primitive? not ] [ symbol? not ] } 1&& ] filter ;
+
+PRIVATE>
+
+: each-word ( string quot -- )
+    over ".private" tail? [
+        [ coverage-words ] dip each
+    ] [
+        [ [ private-vocab-name coverage-words ] dip each ]
+        [ [ coverage-words ] dip each ] 2bi
+    ] if ; inline
+
+: map-words ( string quot -- sequence )
+    over ".private" tail? [
+        [ coverage-words ] dip map
+    ] [
+        [ [ private-vocab-name coverage-words ] dip map ]
+        [ [ coverage-words ] dip map ] 2bi append
+    ] if ; inline
+
 M: string coverage-on
-    words [ coverage-on ] each ;
+    [ coverage-on ] each-word ;
 
 M: string coverage-off ( vocabulary -- )
-    words [ coverage-off ] each ;
+    [ coverage-off ] each-word ;
 
 M: word coverage-on ( word -- )
     H{ } clone [ "coverage" set-word-prop ] 2keep
     '[
         \ coverage new [ _ set-at ] 2keep
-        '[ _ t >>executed? drop ] [ ] surround
+        '[ _ t >>executed? drop ] prepend
     ] deep-annotate ;
 
 M: word coverage-off ( word -- )
     [ reset ] [ f "coverage" set-word-prop ] bi ;
 
+GENERIC: toggle-coverage ( object -- )
+
+M: string toggle-coverage
+    [ toggle-coverage ] each-word ;
+
+M: word toggle-coverage
+    dup "coverage" word-prop [
+        coverage-off
+    ] [
+        coverage-on
+    ] if ;
+
 GENERIC: coverage ( object -- seq )
 
 M: string coverage
-    words [ dup coverage ] { } map>assoc ;
+    [ dup coverage 2array ] map-words ;
 
 M: word coverage ( word -- seq )
     "coverage" word-prop >alist
@@ -40,12 +80,28 @@ M: word coverage ( word -- seq )
 GENERIC: coverage. ( object -- )
 
 M: string coverage.
-    words [ coverage. ] each ;
+    [ coverage. ] each-word ;
 
 M: word coverage.
     dup coverage [
         drop
     ] [
         [ name>> ":" append print ]
-        [ [ bl bl bl bl . ] each ] bi*
+        [ [ "    " write . ] each ] bi*
     ] if-empty ;
+
+<PRIVATE
+
+GENERIC: count-callables ( object -- n )
+
+M: string count-callables
+    [ count-callables ] map-words sum ;
+
+M: word count-callables
+    "coverage" word-prop assoc-size ;
+
+PRIVATE>
+
+: %coverage ( string -- x )
+    [ coverage values concat length ]
+    [ count-callables ] bi [ swap - ] keep /f ; inline