#UI_ENHANCEMENT
class: Tools::MethodCategoryList
changed:
#listOfMethodCategories
#makeGenerator
new pseudo category: "tests not passed"
--- a/Tools__MethodCategoryList.st Fri Jan 22 20:55:41 2016 +0100
+++ b/Tools__MethodCategoryList.st Sat Jan 23 11:26:34 2016 +0100
@@ -909,8 +909,8 @@
documentationProtocols longProtocols extensionProtocols redefinedProtocols
redefineProtocols overrideProtocols
missingRequiredProtocols subclassResponsibilities
- notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
- partiallyCoveredProtocols uncoveredProtocols allTestsProtocols
+ anyCoverage notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
+ partiallyCoveredProtocols uncoveredProtocols allTestsProtocols allTestsNotPassedProtocols
classSelectorPairsAlreadyDone
packages remainingClasses remainingCategories classesAlreadyDone
catListed showChanged|
@@ -934,8 +934,11 @@
partiallyCoveredProtocols := protocols includes:(self class nameListEntryForPartiallyCovered).
uncoveredProtocols := protocols includes:(self class nameListEntryForUncovered).
notInstrumentedProtocols := protocols includes:(self class nameListEntryForNotInstrumented).
+ anyCoverage := fullyCoveredProtocols | partiallyCoveredProtocols
+ | uncoveredProtocols | notInstrumentedProtocols.
allTestsProtocols := protocols includes:(self class nameListEntryForAllTests).
+ allTestsNotPassedProtocols := protocols includes:(self class nameListEntryForTestsNotPassed).
packages := packageFilter value value.
(packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[
@@ -952,16 +955,18 @@
leafClasses do:[:aLeafClass |
(self classesToProcessForClasses:(Array with:aLeafClass)) do:[:aClass |
|supportsMethodCategories isJavaClass anyInThisClass requiredProtocolForClass
- isTestCase allTestSelectors|
+ isTestCaseClass allTestSelectors allTestsNotPassed|
(classesAlreadyDone includes:aClass) ifFalse:[
classesAlreadyDone add:aClass.
supportsMethodCategories := aClass supportsMethodCategories.
isJavaClass := aClass isJavaClass.
- (allTestsProtocols) ifTrue:[
- isTestCase := aClass isMetaclass not and:[aClass isTestCaseLike and:[aClass isAbstract not]].
- isTestCase ifTrue:[
+ isTestCaseClass := false.
+
+ (allTestsProtocols or:[allTestsNotPassedProtocols]) ifTrue:[
+ isTestCaseClass := aClass isTestCaseLike and:[aClass isMetaclass not and:[aClass isAbstract not]].
+ isTestCaseClass ifTrue:[
allTestsProtocols ifTrue:[
allTestSelectors := aClass allTestSelectors asSet.
].
@@ -994,75 +999,96 @@
"/ used to be a more readable or, but to reuse info, I've splitted it.
"/ because we should use the parser only once, we reuse the same methodInfo.
"/ otherwise, the list update becomes too slow for long classes (NewSystemBrowser)
- includeIt := allProtocols.
- includeIt ifFalse:[
- includeIt := protocols includes:cat].
+ includeIt := allProtocols or:[protocols includes:cat].
includeIt ifFalse:[
allTestsProtocols ifTrue:[
- includeIt := allTestSelectors notNil and:[allTestSelectors includes:sel]]].
- includeIt ifFalse:[
- superSendProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info sendsSuper ]].
- includeIt ifFalse:[
- uncommentedProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isUncommented.
- catListed := self class nameListEntryForUncommented ]].
- includeIt ifFalse:[
- obsoleteProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isObsolete ]].
- includeIt ifFalse:[
- documentationProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isDocumentationMethod ]].
- includeIt ifFalse:[
- longProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isLongMethod ]].
- includeIt ifFalse:[
- extensionProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isExtensionMethod.
- catListed := self class nameListEntryForExtensions ]].
- includeIt ifFalse:[
- 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:[
- redefineProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isRedefine ]].
- includeIt ifFalse:[
- subclassResponsibilities ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isSubclassResponsibility ]].
- includeIt ifFalse:[
- annotatedProtocols ifTrue:[
- info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
- includeIt := info isAnnotated ]].
+ includeIt := allTestSelectors notNil and:[allTestSelectors includes:sel]].
+
+ includeIt ifFalse:[
+ (allTestsNotPassedProtocols and:[isTestCaseClass]) ifTrue:[
+ (aClass isTestSelector:sel) ifTrue:[
+ |lastResultOrNil|
- includeIt ifFalse:[
- mthd isInstrumented ifTrue:[
- mthd hasBeenCalled ifTrue:[
- mthd haveAllBlocksBeenExecuted ifTrue:[
- includeIt := fullyCoveredProtocols.
+ lastResultOrNil := aClass rememberedOutcomeFor:sel.
+ includeIt := lastResultOrNil isNil
+ or:[lastResultOrNil result ~~ TestResult statePass]]]].
+
+ includeIt ifFalse:[
+ superSendProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info sendsSuper ]].
+
+ includeIt ifFalse:[
+ uncommentedProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isUncommented.
+ catListed := self class nameListEntryForUncommented ]].
+
+ includeIt ifFalse:[
+ obsoleteProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isObsolete ]].
+
+ includeIt ifFalse:[
+ documentationProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isDocumentationMethod ]].
+
+ includeIt ifFalse:[
+ longProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isLongMethod ]].
+
+ includeIt ifFalse:[
+ extensionProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isExtensionMethod.
+ catListed := self class nameListEntryForExtensions ]].
+
+ includeIt ifFalse:[
+ 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:[
+ redefineProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isRedefine ]].
+
+ includeIt ifFalse:[
+ subclassResponsibilities ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isSubclassResponsibility ]].
+
+ includeIt ifFalse:[
+ annotatedProtocols ifTrue:[
+ info isNil ifTrue:[ info := self methodInfoFor:mthd in:aClass selector:sel ].
+ includeIt := info isAnnotated ]].
+
+ includeIt ifFalse:[
+ anyCoverage ifTrue:[
+ mthd isInstrumented ifTrue:[
+ mthd hasBeenCalled ifTrue:[
+ mthd haveAllBlocksBeenExecuted ifTrue:[
+ includeIt := fullyCoveredProtocols.
+ ] ifFalse:[
+ includeIt := partiallyCoveredProtocols
+ ]
+ ] ifFalse:[
+ includeIt := uncoveredProtocols
+ ].
] ifFalse:[
- includeIt := partiallyCoveredProtocols
- ]
- ] ifFalse:[
- includeIt := uncoveredProtocols
+ includeIt := notInstrumentedProtocols
+ ].
].
- ] ifFalse:[
- includeIt := notInstrumentedProtocols
].
].
-
+
includeIt ifTrue:[
(methodVisibilityHolder value == #class) ifTrue:[
whatToDo value:aClass value:catListed value:sel value:mthd.
@@ -1236,7 +1262,9 @@
emphasizedPlus emphasisForRef emphasisForMod
numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
numRedefine numRedefined numExtension numMissingRequired numSubclassResponsibility
- numAnnotated numFullyCovered numPartiallyCovered numUncovered numNotInstrumented numAllTestResults showPseudoProtocols showCoverageInformation
+ numAnnotated numFullyCovered numPartiallyCovered numUncovered numNotInstrumented
+ numAllTestResults numTestsNotPassed
+ showPseudoProtocols showCoverageInformation
addPseudoEntry addPseudoEntryWithColor countAll pseudoEntryColor userPreferences
startTime suppressPseudoProtocolsNow needsSpecialColoring|
@@ -1289,7 +1317,7 @@
numObsolete := numSuper := numUncommented := numDocumentation := numLong := 0.
numRedefine := numRedefined := numOverride := numExtension := numMissingRequired := numSubclassResponsibility := 0.
numNotInstrumented := numFullyCovered := numPartiallyCovered := numUncovered := 0.
- numAnnotated := numAllTestResults := 0.
+ numAnnotated := numAllTestResults := numTestsNotPassed := 0.
numAll := 0.
generator do:[:clsIn :catIn |
@@ -1397,10 +1425,11 @@
changeSet := ChangeSet current.
classesProcessed do:[:eachClass |
- |classPackage required testOutcomes|
+ |classPackage required testOutcomes isTestCaseClass|
+ isTestCaseClass := eachClass isTestCaseLike and:[eachClass isMeta not and:[eachClass isAbstract not]].
(showSyntheticMethods value ? true) ifTrue:[
- (eachClass isMeta not and:[eachClass isTestCaseLike and:[eachClass isAbstract not]]) ifTrue:[
+ isTestCaseClass ifTrue:[
testOutcomes := eachClass testSelectorsWithLastOutcomes.
numAllTestResults := numAllTestResults + testOutcomes size.
].
@@ -1453,6 +1482,7 @@
].
].
].
+
(changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
(packageFilter notNil
and:[ (packageFilter includes:mPackage) not])
@@ -1465,6 +1495,17 @@
(SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
itemsInRemoteChangeSet add:mCategory.
].
+ isTestCaseClass ifTrue:[
+ (eachClass isTestSelector:mSelector) ifTrue:[
+ |lastResultOrNil|
+
+ lastResultOrNil := eachClass rememberedOutcomeFor:mSelector.
+ (lastResultOrNil isNil or:[lastResultOrNil result ~~ TestResult statePass]) ifTrue:[
+ numTestsNotPassed := numTestsNotPassed + 1
+ ]
+ ].
+ ].
+
testOutcomes notNil ifTrue:[ testOutcomes remove: mSelector ifAbsent:[] ].
].
@@ -1634,7 +1675,8 @@
addPseudoEntry value:self class nameListEntryForSuperSend value:numSuper.
addPseudoEntry value:self class nameListEntryForUncommented value:numUncommented.
addPseudoEntry value:self class nameListEntryForAllTests value:numAllTestResults.
-
+ addPseudoEntry value:self class nameListEntryForTestsNotPassed value:numTestsNotPassed.
+
showCoverageInformation ifTrue:[
addPseudoEntry value:self class nameListEntryForNotInstrumented value:numNotInstrumented.
addPseudoEntryWithColor value:self class nameListEntryForUncovered value:numUncovered value:userPreferences colorForInstrumentedNeverCalledCode.