"{ Package: 'stx:goodies/builder/reports' }"

"{ NameSpace: Builder }"

Report subclass:#CoverageReport

	instanceVariableNames:'instrumentedMethods'

	classVariableNames:''

	poolDictionaries:''

	category:'Builder-Reports'

!

!CoverageReport methodsFor:'accessing-defaults'!

defaultFileSuffix

    "Return a default filename suffix. Note that format suffix will be 

     appended too if not file is explicitely specified"

    ^'Coverage'

    "Created: / 25-06-2013 / 01:12:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

defaultFormat

    "raise an error: must be redefined in concrete subclass(es)"

    ^ Builder::CoverageReportFormat::Cobertura new

    "Modified: / 25-06-2013 / 01:31:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

defaultName

    packages isNil ifTrue:[

        ^'someClasses'.

    ].

    ^String streamContents:[:s|

        packages do:[:packageOrClass|

            s nextPutAll: packageOrClass printString 

        ] separatedBy:[

            s nextPut:$,;space

        ]

    ]

    "Created: / 25-06-2013 / 01:29:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReport methodsFor:'initialization'!

initialize

    instrumentedMethods := Set new.

    "Created: / 25-06-2013 / 01:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 13:21:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupForClasses:classes

    "raise an error: must be redefined in concrete subclass(es)"

    classes do:[:each | self instrumentClass: each].

    "Modified: / 25-06-2013 / 16:22:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupForPackages:pkgs

    "raise an error: must be redefined in concrete subclass(es)"

    pkgs do:[:each | self instrumentPackage: each ].

    "Modified: / 25-06-2013 / 16:22:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReport methodsFor:'instrumentation'!

instrumentClass:class

    class instAndClassMethods do:[:method|

        self instrumentMethod: method 

    ]

    "Created: / 25-06-2013 / 01:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

instrumentMethod:method

    | class selector |

    class := method mclass.

    selector := method selector.

    (self excludedFromCoverage: method) ifFalse:[

        method isInstrumented ifFalse:[

            InstrumentingCompiler compileMethod: method.

        ].

        instrumentedMethods add: (class compiledMethodAt: selector)

    ]

    "Created: / 25-06-2013 / 01:44:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 28-06-2013 / 02:45:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

instrumentPackage:pkg

    Smalltalk allMethodsDo:[:method|

        method package asSymbol == pkg asSymbol ifTrue:[

            self instrumentMethod: method.

        ]

    ]

    "Created: / 25-06-2013 / 01:42:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-06-2013 / 17:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReport methodsFor:'queries'!

excludedFromCoverage: aMethod

    "Returns true, if given method should be excluded from

     coverage report.

     Here, certain 'metadata' method like documentation, copyright,

     version methods, printOn: and so on are exluded. Also, testcases

     and test resources are ommited"

    | mclass mselector tree pkgdef |

    mclass := aMethod mclass.

    mselector := aMethod selector.

    aMethod hasPrimitiveCode ifTrue:[ ^ true ].

    (mclass inheritsFrom: TestCase) ifTrue:[ ^ true ].

    (mclass inheritsFrom: TestResource) ifTrue:[ ^ true ].

    (mclass inheritsFrom: ProjectDefinition) ifTrue:[ ^ true ].

    mclass isMetaclass ifTrue:[

        (#(

                copyright 

                documentation

        ) includes: mselector) ifTrue:[ ^ true ].

        (AbstractSourceCodeManager isVersionMethodSelector: mselector) ifTrue:[ ^ true ].

    ] ifFalse:[

        (#(

            printString printOn: 

            inspectorExtraAttributes inspectorClass

        ) includes: mselector) ifTrue:[ ^ true ].    

    ].

    tree := (Parser parseMethod: aMethod source in: mclass) tree.

    tree isNil ifTrue:[ ^ true ]. "/ empty method?

    (tree isStatement and:[tree isReturnNode not and:[tree nextStatement isNil]]) ifTrue:[

        tree := tree expression.

    ].

    "/ Exclude all getters/return constants...

    (aMethod numArgs == 0 

        and:[tree isReturnNode 

        and:[tree expression isVariable or:[tree expression isConstant]]]) ifTrue:[ ^ true ].

    "/ Exclude all setters

    (aMethod numArgs == 1 

        and:[tree isAssignment 

        and:[(tree variable isInstanceVariable or:[tree variable isClassVariable])

        and:[tree expression isVariable

        and:[tree expression isMethodArg]]]]) ifTrue:[ ^ true ].

    pkgdef := ProjectDefinition definitionClassForPackage: aMethod package.

    pkgdef notNil ifTrue:[

        ^ pkgdef excludedFromCoverage:aMethod.

    ].

    ^ false

    "Created: / 28-06-2013 / 02:20:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 28-06-2013 / 11:31:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReport methodsFor:'running'!

runReport

    "Actually run the report. What to do (what classes/packages to check)

     must be stored instance variables"

    format write: instrumentedMethods.

    "Modified: / 25-06-2013 / 13:13:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CoverageReport class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

!

version_SVN

    ^ '$Id$'

! !