--- a/Tools_MethodCategoryList.st Tue Apr 27 19:03:38 2010 +0200
+++ b/Tools_MethodCategoryList.st Tue Apr 27 19:04:08 2010 +0200
@@ -18,7 +18,7 @@
leafClasses protocolList rawProtocolList selectedProtocolIndices
lastGeneratedProtocols packageFilterOnInput
methodVisibilityHolder noAllItem noPseudoItems
- showPseudoProtocols'
+ showPseudoProtocols showCoverageInformation'
classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache
MethodInfoCacheAccessLock'
poolDictionaries:''
@@ -203,7 +203,10 @@
#updateTrigger
#variableFilter
#methodVisibilityHolder
+ #showCoverageInformation
).
+
+ "Modified: / 27-04-2010 / 16:40:39 / cg"
! !
!MethodCategoryList methodsFor:'aspects'!
@@ -340,6 +343,28 @@
^ self selectionHolder:aValueHolder
!
+showCoverageInformation
+ showCoverageInformation isNil ifTrue:[
+ showCoverageInformation := false asValue.
+ showCoverageInformation addDependent:self
+ ].
+ ^ showCoverageInformation
+
+ "Created: / 27-04-2010 / 16:40:21 / cg"
+!
+
+showCoverageInformation:aValueHolder
+ showCoverageInformation notNil ifTrue:[
+ showCoverageInformation removeDependent:self
+ ].
+ showCoverageInformation := aValueHolder.
+ showCoverageInformation notNil ifTrue:[
+ showCoverageInformation addDependent:self
+ ].
+
+ "Created: / 27-04-2010 / 16:40:27 / cg"
+!
+
showPseudoProtocols
showPseudoProtocols isNil ifTrue:[
showPseudoProtocols := true asValue.
@@ -1065,10 +1090,13 @@
generator nm variablesToHighlight classVarsToHighLight
itemsWithVarRefs itemsWithVarMods itemsWithExtensions itemsWithSuppressedExtensions
itemsInChangeSet itemsInRemoteChangeSet
+ itemsWithInstrumentedMethods itemsWithCalledMethods itemsWithUncalledMethods
+ itemsWithPartiallyCoveredMethods itemsWithFullyCoveredMethods
packageFilterOnInput packageFilter nameListEntryForALL changeSet
emphasizedPlus emphasisForRef emphasisForMod
numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
- numRedefine numExtension numMissingRequired numSubclassResponsibility showPseudoProtocols
+ numRedefine numExtension numMissingRequired numSubclassResponsibility
+ showPseudoProtocols showCoverageInformation
addPseudoEntry countAll pseudoEntryColor|
countAll := true.
@@ -1078,6 +1106,7 @@
showPseudoProtocols := self showPseudoProtocols value
and:[builder window notNil and:[builder window shown]].
+ showCoverageInformation := self showCoverageInformation value.
nameListEntryForALL := self class nameListEntryForALL.
@@ -1097,6 +1126,13 @@
itemsWithSuppressedExtensions := Set new.
itemsInChangeSet := Set new.
itemsInRemoteChangeSet := Set new.
+
+ itemsWithInstrumentedMethods := Set new.
+ itemsWithCalledMethods := Set new.
+ itemsWithUncalledMethods := Set new.
+ itemsWithPartiallyCoveredMethods := Set new.
+ itemsWithFullyCoveredMethods := Set new.
+
plainCategories := Set new.
classesProcessed := IdentitySet new.
leafClassesProcessed := IdentitySet new.
@@ -1215,11 +1251,28 @@
].
].
].
- (changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
- itemsInChangeSet add:mCategory.
- ].
- (SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
- itemsInRemoteChangeSet add:mCategory.
+
+ showCoverageInformation ifTrue:[
+ mthd isInstrumented ifTrue:[
+ itemsWithInstrumentedMethods add:mCategory.
+ mthd hasBeenCalled ifTrue:[
+ itemsWithCalledMethods add:mCategory.
+ mthd haveAllBlocksBeenExecuted ifTrue:[
+ itemsWithFullyCoveredMethods add:mCategory.
+ ] ifFalse:[
+ itemsWithPartiallyCoveredMethods add:mCategory.
+ ].
+ ] ifFalse:[
+ itemsWithUncalledMethods add:mCategory.
+ ].
+ ].
+ ] ifFalse:[
+ (changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
+ itemsInChangeSet add:mCategory.
+ ].
+ (SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
+ itemsInRemoteChangeSet add:mCategory.
+ ].
].
].
showPseudoProtocols value ifTrue:[
@@ -1241,20 +1294,48 @@
(itemsInChangeSet notEmpty
or:[itemsInRemoteChangeSet notEmpty
or:[itemsWithExtensions notEmpty
- or:[itemsWithVarRefs notEmpty]] ]) ifTrue:[
+ or:[itemsWithVarRefs notEmpty
+ or:[itemsWithInstrumentedMethods notEmpty
+ or:[itemsWithCalledMethods notEmpty
+ or:[itemsWithUncalledMethods notEmpty
+ or:[itemsWithFullyCoveredMethods notEmpty
+ or:[itemsWithPartiallyCoveredMethods notEmpty
+ ]]]]]]]]) ifTrue:[
rawProtocolList keysAndValuesDo:[:idx :cat |
- |item inChangeSet inRemoteChangeSet hasExtensions hasVarRef hasVarMod|
+ |item inChangeSet inRemoteChangeSet hasExtensions hasVarRef hasVarMod
+ emp|
item := cat.
- inChangeSet := itemsInChangeSet includes:cat.
- inChangeSet ifTrue:[
- item := self colorizeForChangedCode:cat.
- ].
+ inChangeSet := false.
- inRemoteChangeSet := itemsInRemoteChangeSet includes:cat.
- inRemoteChangeSet ifTrue:[
- item := (self colorizeForChangedCodeInSmallTeam:'!! '),item.
+ showCoverageInformation ifTrue:[
+ (itemsWithInstrumentedMethods includes:cat) ifTrue:[
+ (itemsWithCalledMethods includes:cat) ifTrue:[
+ (itemsWithPartiallyCoveredMethods includes:cat) ifTrue:[
+ emp := (UserPreferences current emphasisForInstrumentedPartiallyCoveredCode).
+ ] ifFalse:[
+ (itemsWithUncalledMethods includes:cat) ifTrue:[
+ emp := (UserPreferences current emphasisForInstrumentedPartiallyCoveredCode).
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForInstrumentedFullyCoveredCode).
+ ]
+ ]
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForInstrumentedNeverCalledCode).
+ ].
+ item := self colorize:cat with:emp.
+ ]
+ ] ifFalse:[
+ inChangeSet := itemsInChangeSet includes:cat.
+ inChangeSet ifTrue:[
+ item := self colorizeForChangedCode:cat.
+ ].
+
+ inRemoteChangeSet := itemsInRemoteChangeSet includes:cat.
+ inRemoteChangeSet ifTrue:[
+ item := (self colorizeForChangedCodeInSmallTeam:'!! '),item.
+ ].
].
hasVarRef := itemsWithVarRefs includes:cat.
@@ -1349,7 +1430,7 @@
^ categoryList
"Created: / 05-02-2000 / 13:42:11 / cg"
- "Modified: / 10-11-2006 / 17:35:53 / cg"
+ "Modified: / 27-04-2010 / 18:56:08 / cg"
!
makeDependent
@@ -1763,11 +1844,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.53 2009-11-20 16:45:49 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.54 2010-04-27 17:04:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.53 2009-11-20 16:45:49 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.54 2010-04-27 17:04:08 cg Exp $'
! !
MethodCategoryList initialize!