From 98b154c14e34267d6748a40b8adca2d94132ae87 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 26 Aug 2011 14:32:41 -0500 Subject: [PATCH 1/4] Rename tools.code-coverage to tools.coverage, change some word names. --- .../tools/code-coverage/code-coverage.factor | 51 ------------------- .../{code-coverage => coverage}/authors.txt | 0 basis/tools/coverage/coverage.factor | 51 +++++++++++++++++++ .../{code-coverage => coverage}/summary.txt | 0 4 files changed, 51 insertions(+), 51 deletions(-) delete mode 100644 basis/tools/code-coverage/code-coverage.factor rename basis/tools/{code-coverage => coverage}/authors.txt (100%) create mode 100644 basis/tools/coverage/coverage.factor rename basis/tools/{code-coverage => coverage}/summary.txt (100%) diff --git a/basis/tools/code-coverage/code-coverage.factor b/basis/tools/code-coverage/code-coverage.factor deleted file mode 100644 index 5aabb1fb25..0000000000 --- a/basis/tools/code-coverage/code-coverage.factor +++ /dev/null @@ -1,51 +0,0 @@ -! 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 ; -IN: tools.code-coverage - -TUPLE: coverage < identity-tuple executed? ; - -C: coverage - -GENERIC: code-coverage-on ( object -- ) - -GENERIC: code-coverage-off ( object -- ) - -M: string code-coverage-on - words [ code-coverage-on ] each ; - -M: string code-coverage-off ( vocabulary -- ) - words [ code-coverage-off ] each ; - -M: word code-coverage-on ( word -- ) - H{ } clone [ "code-coverage" set-word-prop ] 2keep - '[ - coverage new [ _ set-at ] 2keep - '[ _ t >>executed? drop ] [ ] surround - ] deep-annotate ; - -M: word code-coverage-off ( word -- ) - [ reset ] [ f "code-coverage" set-word-prop ] bi ; - -GENERIC: untested ( object -- seq ) - -M: string untested - words [ dup untested ] { } map>assoc ; - -M: word untested ( word -- seq ) - "code-coverage" word-prop >alist - [ drop executed?>> not ] assoc-filter values ; - -GENERIC: show-untested ( object -- ) - -M: string show-untested - words [ show-untested ] each ; - -M: word show-untested - dup untested [ - drop - ] [ - [ name>> ":" append print ] - [ [ bl bl bl bl . ] each ] bi* - ] if-empty ; diff --git a/basis/tools/code-coverage/authors.txt b/basis/tools/coverage/authors.txt similarity index 100% rename from basis/tools/code-coverage/authors.txt rename to basis/tools/coverage/authors.txt diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor new file mode 100644 index 0000000000..62be43ea47 --- /dev/null +++ b/basis/tools/coverage/coverage.factor @@ -0,0 +1,51 @@ +! 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 ; +IN: tools.coverage + +TUPLE: coverage < identity-tuple executed? ; + +C: coverage + +GENERIC: coverage-on ( object -- ) + +GENERIC: coverage-off ( object -- ) + +M: string coverage-on + words [ coverage-on ] each ; + +M: string coverage-off ( vocabulary -- ) + words [ coverage-off ] each ; + +M: word coverage-on ( word -- ) + H{ } clone [ "coverage" set-word-prop ] 2keep + '[ + \ coverage new [ _ set-at ] 2keep + '[ _ t >>executed? drop ] [ ] surround + ] deep-annotate ; + +M: word coverage-off ( word -- ) + [ reset ] [ f "coverage" set-word-prop ] bi ; + +GENERIC: coverage ( object -- seq ) + +M: string coverage + words [ dup coverage ] { } map>assoc ; + +M: word coverage ( word -- seq ) + "coverage" word-prop >alist + [ drop executed?>> not ] assoc-filter values ; + +GENERIC: coverage. ( object -- ) + +M: string coverage. + words [ coverage. ] each ; + +M: word coverage. + dup coverage [ + drop + ] [ + [ name>> ":" append print ] + [ [ bl bl bl bl . ] each ] bi* + ] if-empty ; diff --git a/basis/tools/code-coverage/summary.txt b/basis/tools/coverage/summary.txt similarity index 100% rename from basis/tools/code-coverage/summary.txt rename to basis/tools/coverage/summary.txt From 80618ef403d30e7f4ab864bbea03563418b1e170 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 26 Aug 2011 15:03:55 -0500 Subject: [PATCH 2/4] Add a bunch of unit tests for 100% code coverage in sets vocab --- core/sets/sets-tests.factor | 44 +++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index 15b251736b..86aebb9dc3 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -1,6 +1,7 @@ -! Copyright (C) 2010 Daniel Ehrenberg +! Copyright (C) 2010 Daniel Ehrenberg, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: sets tools.test kernel prettyprint hash-sets sorting ; +USING: sets tools.test kernel prettyprint hash-sets sorting +math sequences bit-sets bit-arrays ; IN: sets.tests [ V{ 1 2 3 } ] [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test @@ -8,16 +9,26 @@ IN: sets.tests [ t ] [ 4 { 2 4 5 } in? ] unit-test [ f ] [ 1 { 2 4 5 } in? ] unit-test +[ f ] [ f 5 in? ] unit-test [ V{ 1 2 } ] [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test [ V{ 2 } ] [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test +[ 0 ] [ 5 0 over delete cardinality ] unit-test +[ 0 ] [ 5 f over delete cardinality ] unit-test +[ 0 ] [ 5 3 over adjoin 3 over delete cardinality ] unit-test +[ 0 ] [ 5 10 over delete cardinality ] unit-test +[ HS{ 1 } ] [ HS{ 1 2 } 2 over delete ] unit-test [ { 1 2 3 } ] [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test [ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test [ { 1 2 3 } ] [ { 1 2 2 3 3 } { } set-like ] unit-test [ { 3 2 1 } ] [ { 3 3 2 2 1 } { } set-like ] unit-test +[ t ] [ 4 1 set-like 4 = ] unit-test +[ t ] [ { 1 2 3 } HS{ } set-like HS{ 1 2 3 } = ] unit-test [ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test +[ T{ bit-set { table ?{ f } } } ] +[ 1 fast-set ] unit-test [ { 1 } ] [ { 1 } members ] unit-test @@ -42,6 +53,9 @@ IN: sets.tests [ { 1 } ] [ { 1 2 3 4 } { 2 3 4 } diff ] unit-test [ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test +[ T{ bit-set { table ?{ f f f } } } ] +[ 3 0 over adjoin dup diff ] unit-test + [ f ] [ { 1 2 3 4 } { 1 2 } subset? ] unit-test [ t ] [ { 1 2 3 4 } { 1 2 } swap subset? ] unit-test [ t ] [ { 1 2 } { 1 2 } subset? ] unit-test @@ -58,15 +72,24 @@ IN: sets.tests [ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test [ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test +[ t ] [ HS{ 0 1 2 3 4 5 } all-unique? ] unit-test [ t ] [ f null? ] unit-test [ f ] [ { 4 } null? ] unit-test +[ t ] [ HS{ } null? ] unit-test +[ f ] [ HS{ 3 } null? ] unit-test +[ t ] [ 2 null? ] unit-test +[ f ] [ 3 0 over adjoin null? ] unit-test [ 0 ] [ f cardinality ] unit-test [ 0 ] [ { } cardinality ] unit-test [ 1 ] [ { 1 } cardinality ] unit-test [ 1 ] [ HS{ 1 } cardinality ] unit-test [ 3 ] [ HS{ 1 2 3 } cardinality ] unit-test +[ 0 ] [ 0 cardinality ] unit-test +[ 0 ] [ 5 cardinality ] unit-test +[ 2 ] [ 5 0 over adjoin 1 over adjoin cardinality ] unit-test +[ 1 ] [ 5 1 over adjoin cardinality ] unit-test [ { } ] [ { } { } within ] unit-test [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test @@ -77,8 +100,25 @@ IN: sets.tests [ { 1 1 } ] [ { 1 1 2 3 3 } { 2 3 4 4 } without ] unit-test [ { 1 2 3 } ] [ { { 1 } { 2 } { 1 3 } } combine ] unit-test +[ f ] [ { } combine ] unit-test + +[ { 1 4 9 16 25 36 } ] +[ { { 1 2 3 } { 4 5 6 } } [ [ sq ] map ] gather ] unit-test [ H{ { 3 HS{ 1 2 } } } ] [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test [ H{ { 3 H{ { 1 1 } { 2 2 } } } } ] [ H{ } clone 1 3 pick conjoin-at 2 3 pick conjoin-at ] unit-test +TUPLE: null-set ; +INSTANCE: null-set set +M: null-set members drop f ; + +[ 0 ] [ T{ null-set } cardinality ] unit-test +[ f ] [ T{ null-set } members ] unit-test +[ t ] [ T{ null-set } T{ null-set } set-like T{ null-set } = ] unit-test + +[ t ] [ T{ null-set } set? ] unit-test +[ t ] [ HS{ } set? ] unit-test +[ t ] [ { } set? ] unit-test +[ t ] [ 5 set? ] unit-test +[ f ] [ H{ } set? ] unit-test From 4d3ae366749a90fd1a32305851aadac8abe16222 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 26 Aug 2011 15:39:27 -0500 Subject: [PATCH 3/4] Add docs for tools.coverage --- basis/tools/coverage/coverage-docs.factor | 45 +++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 basis/tools/coverage/coverage-docs.factor diff --git a/basis/tools/coverage/coverage-docs.factor b/basis/tools/coverage/coverage-docs.factor new file mode 100644 index 0000000000..2964abb51c --- /dev/null +++ b/basis/tools/coverage/coverage-docs.factor @@ -0,0 +1,45 @@ +! Copyright (C) 2011 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel sequences ; +IN: tools.coverage + +HELP: +{ $values + { "executed?" boolean } + { "coverage" coverage } +} +{ $description "Makes a coverage tuple. Users should not call this directly." } ; + +HELP: coverage +{ $values + { "object" object } + { "seq" sequence } +} +{ $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." } ; + +HELP: coverage-on +{ $values + { "object" object } +} +{ $description "Activates the coverage tool on a word or vocabulary." } ; + +HELP: coverage. +{ $values + { "object" object } +} +{ $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" +"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 } +"Examining coverage data:" +{ $subsections coverage coverage. } ; + +ABOUT: "tools.coverage" From 8d4ba7e2b61c4013180e47ddc8c2fb43365e5577 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 26 Aug 2011 17:11:50 -0500 Subject: [PATCH 4/4] Clean up some duplication in annotate/deep-annotate --- basis/tools/annotations/annotations.factor | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index c37df58519..c5c810fe04 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -36,24 +36,29 @@ M: cannot-annotate-twice summary drop "Cannot annotate a word twice" ; cannot-annotate-twice ] when ; +: annotate-generic ( word quot -- ) + [ "methods" word-prop values ] dip each ; inline + +: prepare-annotate ( word quot -- word quot quot ) + [ check-annotate-twice ] dip + [ dup def>> 2dup "unannotated-def" set-word-prop ] dip ; + GENERIC# (annotate) 1 ( word quot -- ) M: generic (annotate) - [ "methods" word-prop values ] dip '[ _ (annotate) ] each ; + '[ _ (annotate) ] annotate-generic ; M: word (annotate) - [ check-annotate-twice ] dip - [ dup def>> 2dup "unannotated-def" set-word-prop ] dip + prepare-annotate call( old -- new ) define ; GENERIC# (deep-annotate) 1 ( word quot -- ) M: generic (deep-annotate) - [ "methods" word-prop values ] dip '[ _ (deep-annotate) ] each ; + '[ _ (deep-annotate) ] annotate-generic ; M: word (deep-annotate) - [ check-annotate-twice ] dip - [ dup def>> 2dup "unannotated-def" set-word-prop ] dip + prepare-annotate '[ dup callable? [ _ call( old -- new ) ] when ] deep-map define ; PRIVATE>