changed:
#listOfMethodCategories
#makeGenerator
#methodInfoFor:in:selector:lazy:
--- a/Tools_MethodCategoryList.st Sat Oct 20 15:38:19 2012 +0200
+++ b/Tools_MethodCategoryList.st Sat Oct 20 15:49:14 2012 +0200
@@ -29,8 +29,8 @@
instanceVariableNames:'flags'
classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented
FlagIsDocumentationMethod FlagIsLongMethod FlagIsExtension
- FlagIsRedefine FlagIsOverride FlagIsSubclassResponsibility
- FlagIsTest FlagIsAnnotated'
+ FlagIsRedefine FlagIsRedefined FlagIsOverride
+ FlagIsSubclassResponsibility FlagIsTest FlagIsAnnotated'
poolDictionaries:''
privateIn:MethodCategoryList
!
@@ -848,7 +848,8 @@
on:[:whatToDo |
|protocols
allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols
- documentationProtocols longProtocols extensionProtocols redefinedProtocols overrideProtocols
+ documentationProtocols longProtocols extensionProtocols redefinedProtocols
+ redefineProtocols overrideProtocols
missingRequiredProtocols subclassResponsibilities
notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
partiallyCoveredProtocols uncoveredProtocols
@@ -875,6 +876,7 @@
longProtocols := protocols includes:(self class nameListEntryForLong).
extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
+ redefineProtocols := protocols includes:(self class nameListEntryForRedefine).
overrideProtocols := protocols includes:(self class nameListEntryForOverride).
missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
subclassResponsibilities := protocols includes:(self class nameListEntryForMustBeRedefinedInSubclass).
@@ -964,8 +966,12 @@
overrideProtocols ifTrue:[
info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
includeIt := info isOverride ]].
+"/ includeIt ifFalse:[
+"/ redefinedProtocols ifTrue:[
+"/ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+"/ includeIt := info isRedefined ]].
includeIt ifFalse:[
- redefinedProtocols ifTrue:[
+ redefineProtocols ifTrue:[
info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
includeIt := info isRedefine ]].
includeIt ifFalse:[
@@ -1155,7 +1161,7 @@
packageFilterOnInput packageFilter nameListEntryForALL changeSet
emphasizedPlus emphasisForRef emphasisForMod
numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
- numRedefine numExtension numMissingRequired numSubclassResponsibility
+ numRedefine numRedefined numExtension numMissingRequired numSubclassResponsibility
numAnnotated numFullyCovered numPartiallyCovered numUncovered numNotInstrumented
showPseudoProtocols showCoverageInformation
addPseudoEntry addPseudoEntryWithColor countAll pseudoEntryColor userPreferences
@@ -1205,7 +1211,7 @@
variablesToHighlight := variableFilter value.
classVarsToHighLight := filterClassVars value.
numObsolete := numSuper := numUncommented := numDocumentation := numLong := 0.
- numRedefine := numOverride := numExtension := numMissingRequired := numSubclassResponsibility := 0.
+ numRedefine := numRedefined := numOverride := numExtension := numMissingRequired := numSubclassResponsibility := 0.
numNotInstrumented := numFullyCovered := numPartiallyCovered := numUncovered := 0.
numAnnotated := 0.
@@ -1275,7 +1281,7 @@
(includedCats includes:(cat := mthd category)) ifTrue:[
categoryBag add:cat.
- lazyPseudoProtocols ifTrue:[
+ lazyPseudoProtocols ifFalse:[
info := self methodInfoFor:mthd in:cls selector:sel lazy:lazyPseudoProtocols.
info notNil ifTrue:[
info isObsolete ifTrue:[ numObsolete := numObsolete + 1 ].
@@ -1286,6 +1292,7 @@
info isExtensionMethod ifTrue:[ numExtension := numExtension + 1 ].
info isOverride ifTrue:[ numOverride := numOverride + 1 ].
info isRedefine ifTrue:[ numRedefine := numRedefine + 1 ].
+ info isRedefined ifTrue:[ numRedefined := numRedefined + 1 ].
info isSubclassResponsibility ifTrue:[ numSubclassResponsibility := numSubclassResponsibility + 1].
info isAnnotated ifTrue:[ numAnnotated := numAnnotated + 1].
].
@@ -1507,29 +1514,31 @@
addPseudoEntry := [:s :n | addPseudoEntryWithColor value:s value:n value:pseudoEntryColor].
- addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
- addPseudoEntry value:self class nameListEntryForRedefined value:numRedefine.
+ addPseudoEntry value:self class nameListEntryForAnnotated value:numAnnotated.
addPseudoEntry value:self class nameListEntryForDocumentation value:numDocumentation.
- addPseudoEntry value:self class nameListEntryForUncommented value:numUncommented.
+ addPseudoEntry value:self class nameListEntryForExtensions value:numExtension.
addPseudoEntry value:self class nameListEntryForLong value:numLong.
- addPseudoEntry value:self class nameListEntryForObsolete value:numObsolete.
- addPseudoEntry value:self class nameListEntryForExtensions value:numExtension.
- addPseudoEntry value:self class nameListEntryForOverride value:numOverride.
addPseudoEntry value:self class nameListEntryForMustBeRedefinedInSubclass value:numSubclassResponsibility.
- addPseudoEntry value:self class nameListEntryForAnnotated value:numAnnotated.
- showCoverageInformation ifTrue:[
- addPseudoEntryWithColor value:self class nameListEntryForPartiallyCovered value:numPartiallyCovered value:userPreferences colorForInstrumentedPartiallyCoveredCode.
- addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.
- addPseudoEntryWithColor value:self class nameListEntryForFullyCovered value:numFullyCovered value:userPreferences colorForInstrumentedFullyCoveredCode.
- addPseudoEntry value:self class nameListEntryForNotInstrumented value:numNotInstrumented.
- ].
-
+ addPseudoEntry value:self class nameListEntryForObsolete value:numObsolete.
+ addPseudoEntry value:self class nameListEntryForOverride value:numOverride.
+ addPseudoEntry value:self class nameListEntryForRedefine value:numRedefine.
+ addPseudoEntry value:self class nameListEntryForRedefined value:numRedefined.
"/ I think red is too much of an alert color (and we get more of them as we think...)
"/ numMissingRequired > 0 ifTrue:[
"/ categoryList add:((self class nameListEntryForRequired bindWith:numMissingRequired) allItalic "colorizeAllWith:Color red").
"/ rawProtocolList add:self class nameListEntryForRequired.
"/ ].
addPseudoEntry value:self class nameListEntryForRequired value:numMissingRequired.
+ addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
+ addPseudoEntry value:self class nameListEntryForUncommented value:numUncommented.
+
+ showCoverageInformation ifTrue:[
+ addPseudoEntry value:self class nameListEntryForNotInstrumented value:numNotInstrumented.
+ addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.
+ addPseudoEntryWithColor value:self class nameListEntryForPartiallyCovered value:numPartiallyCovered value:userPreferences colorForInstrumentedPartiallyCoveredCode.
+ addPseudoEntryWithColor value:self class nameListEntryForFullyCovered value:numFullyCovered value:userPreferences colorForInstrumentedFullyCoveredCode.
+ ].
+
].
^ categoryList
@@ -1636,7 +1645,7 @@
"/ reduce the average blocking time, and to allow for debugging the info generating
"/ code without deadlock
MethodInfoCacheAccessLock critical:[
- info := MethodInfoCache at:(mclass name,'>>',selector) ifAbsent:nil.
+ info := MethodInfoCache at:aMethod "(mclass name,'>>',selector)" ifAbsent:nil.
].
info isNil ifTrue:[
lazy ifTrue:[
@@ -1674,12 +1683,18 @@
and:[ mclass superclass notNil
and:[ (mclass superclass whichClassIncludesSelector:selector ) notNil ]]])
).
+"/ too expensive - makes browser slow
+"/ info isRedefined:(
+"/ ( isVersionMethod not
+"/ and:[ isDocumentationMethod not
+"/ and:[ mclass allSubclasses contains:[:cls | cls includesSelector:selector ]]])
+"/ ).
info isSubclassResponsibility:( aMethod sends:#subclassResponsibility or:#subclassResponsibility: ).
info isAnnotated:(aMethod hasAnnotation).
MethodInfoCacheAccessLock critical:[
- MethodInfoCache at:(mclass name,'>>',selector) put:info
+ MethodInfoCache at:aMethod "(mclass name,'>>',selector)" put:info
].
].
].
@@ -1852,6 +1867,7 @@
FlagIsSubclassResponsibility := 128.
FlagIsTest := 256.
FlagIsAnnotated := 512.
+ FlagIsRedefined := 1024.
"Modified: / 08-03-2010 / 18:33:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-09-2011 / 10:04:30 / cg"
@@ -1943,6 +1959,16 @@
ifFalse:[ flags bitClear: FlagIsRedefine]
!
+isRedefined
+ ^ (flags ? 0) bitTest: FlagIsRedefined
+!
+
+isRedefined:aBoolean
+ flags := aBoolean
+ ifTrue:[ flags bitOr: FlagIsRedefined ]
+ ifFalse:[ flags bitClear: FlagIsRedefined]
+!
+
isSubclassResponsibility
^ (flags ? 0) bitTest: FlagIsSubclassResponsibility
!
@@ -2025,11 +2051,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.82 2012-10-19 15:00:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.83 2012-10-20 13:49:14 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.82 2012-10-19 15:00:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.83 2012-10-20 13:49:14 cg Exp $'
! !
MethodCategoryList initialize!