steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge remote-tracking branch 'erg/master'

db4
John Benediktsson 2011-08-26 18:53:58 -07:00
parent e026eb0db4 8d4ba7e2b6
commit f1e51fa4ef
7 changed files with 149 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/tools/annotations/annotations.factor
View File

@ -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>

51
basis/tools/code-coverage/code-coverage.factor
View File

@ -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> 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 ;

0
basis/tools/code-coverage/authors.txt → basis/tools/coverage/authors.txt
View File

45
basis/tools/coverage/coverage-docs.factor Normal file
View File

@ -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: <coverage>
{ $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"

51
basis/tools/coverage/coverage.factor Normal file
View File

@ -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> 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 ;

0
basis/tools/code-coverage/summary.txt → basis/tools/coverage/summary.txt
View File

44
core/sets/sets-tests.factor
View File

@ -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 <bit-set> 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 <bit-set> 0 over delete cardinality ] unit-test
[ 0 ] [ 5 <bit-set> f over delete cardinality ] unit-test
[ 0 ] [ 5 <bit-set> 3 over adjoin 3 over delete cardinality ] unit-test
[ 0 ] [ 5 <bit-set> 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 <bit-set> 1 <bit-set> set-like 4 <bit-set> = ] 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 <bit-set> 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 <bit-set> 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 <bit-set> null? ] unit-test
[ f ] [ 3 <bit-set> 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 <bit-set> cardinality ] unit-test
[ 0 ] [ 5 <bit-set> cardinality ] unit-test
[ 2 ] [ 5 <bit-set> 0 over adjoin 1 over adjoin cardinality ] unit-test
[ 1 ] [ 5 <bit-set> 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 <bit-set> set? ] unit-test
[ f ] [ H{ } set? ] unit-test