--- a/DebugView.st Sat Jan 23 06:59:30 2016 +0100
+++ b/DebugView.st Sun Jan 24 06:56:35 2016 +0100
@@ -8219,56 +8219,59 @@
canDefineForCallee:callee
"again, pure heuristics here"
- |mthd app heuristic selector|
+ |mthd app heuristic selector sender|
+
+ callee isNil ifTrue:[^ false].
classToDefineIn := selectorToDefine := nil. "/ sorry - left as info to define action
- callee notNil ifTrue:[
- "/ clicked on an unimplemented method ?
- callee sender notNil ifTrue:[
- mthd := callee sender method.
- mthd isNil ifTrue:[
- callee sender isBlockContext ifFalse:[
- "/ an unimplemented method
- selector := callee sender selector.
- (callee sender receiver class canUnderstand:selector) ifFalse:[
- classToDefineIn := callee sender receiver class.
- selectorToDefine := selector.
- ^ true
- ]
- ]
- ].
- ].
-
- mthd := callee method.
- mthd notNil ifTrue:[
- (mthd selector == #subclassResponsibility) ifTrue:[
- classToDefineIn := callee sender receiver class.
- selectorToDefine := callee sender selector.
- ^ true.
- ].
-
- "/ that's a big hack, but I am tired of navigating to find the missing menu message...
- "/ you will thank me!!
- mthd selector == #error:mayProceed: ifTrue:[
- (callee receiver isKindOf:MenuPanel) ifTrue:[
- callee sender home notNil ifTrue:[
- (callee sender home selector startsWith:'accept:') ifTrue:[
- (inspectedProcess notNil and:[inspectedProcess isGUIProcess]) ifTrue:[
- (app := self processesApplication) notNil ifTrue:[
- heuristic := callee sender home argsAndVars select:[:o | o isSymbol].
- heuristic size == 1 ifTrue:[
- classToDefineIn := app class.
- selectorToDefine := heuristic first.
- ^ true
- ].
- ].
- ].
- ].
- ].
- ].
- ]
- ]
+ "/ clicked on an unimplemented method ?
+ sender := callee sender.
+ sender isNil ifTrue:[^ false].
+
+ mthd := sender method.
+ mthd isNil ifTrue:[
+ sender isBlockContext ifFalse:[
+ "/ an unimplemented method
+ selector := sender selector.
+ (sender receiver class canUnderstand:selector) ifFalse:[
+ classToDefineIn := sender receiver class.
+ selectorToDefine := selector.
+ ^ true
+ ]
+ ]
+ ].
+
+ mthd := callee method.
+ mthd notNil ifTrue:[
+ (mthd selector == #subclassResponsibility) ifTrue:[
+ classToDefineIn := sender receiver class.
+ selectorToDefine := sender selector.
+ ^ true.
+ ].
+
+ "/ that's a big hack, but I am tired of navigating to find the missing menu message...
+ "/ you will thank me!!
+ mthd selector == #error:mayProceed: ifTrue:[
+ (callee receiver isKindOf:MenuPanel) ifTrue:[
+ |senderHome|
+
+ (senderHome := sender home) notNil ifTrue:[
+ (senderHome selector startsWith:'accept:') ifTrue:[
+ (inspectedProcess notNil and:[inspectedProcess isGUIProcess]) ifTrue:[
+ (app := self processesApplication) notNil ifTrue:[
+ heuristic := senderHome argsAndVars select:[:o | o isSymbol].
+ heuristic size == 1 ifTrue:[
+ classToDefineIn := app class.
+ selectorToDefine := heuristic first.
+ ^ true
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ]
].
^ false
!
--- a/InspectorView.st Sat Jan 23 06:59:30 2016 +0100
+++ b/InspectorView.st Sun Jan 24 06:56:35 2016 +0100
@@ -1360,8 +1360,6 @@
"/ (anObject isNil and:[object isNil]) ifTrue:[^ self].
-Transcript show:'object: '; showCR:object.
-Transcript show:'anObject: '; showCR:anObject.
sameObject := (anObject == object) and:[object notNil].
"/ JV@2011-08-06: Be carefull here, classes may be variable-lenght,
@@ -1369,14 +1367,9 @@
"/ (caused problems expecially when stack inspector is shown in debugger).
"/ To fix, I've added ------------------------v
sameClass := (anObject class == object class) and:[anObject class isVariable not].
-Transcript show:'sameObject: '; showCR:sameObject.
-Transcript showCR:sameClass.
-Transcript showCR:selectionIndex.
-Transcript showCR:(listView list ? #()).
selectionIndex notNil ifTrue:[
oldSelectedField := (listView list ? #()) at:selectionIndex ifAbsent:nil.
].
-Transcript showCR:oldSelectedField.
inspectedObject := object := anObject.
keepList := ((sameObject | sameClass) and:[listView list notEmptyOrNil]).
--- a/Tools__MethodCategoryList.st Sat Jan 23 06:59:30 2016 +0100
+++ b/Tools__MethodCategoryList.st Sun Jan 24 06:56:35 2016 +0100
@@ -819,10 +819,11 @@
].
].
- something == #coverageInfo ifTrue:[
- listValid == true ifTrue:[
- self enqueueDelayedUpdateList
- ].
+ something == #lastTestRunResult ifTrue:[
+ cls := aParameter at:1.
+ (classes notNil and:[classes includesIdentical:cls]) ifTrue:[
+ self invalidateList.
+ ].
^ self.
].
@@ -909,8 +910,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 +935,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 +956,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 +1000,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 +1263,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 +1318,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 +1426,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 +1483,7 @@
].
].
].
+
(changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
(packageFilter notNil
and:[ (packageFilter includes:mPackage) not])
@@ -1465,6 +1496,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 +1676,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.
--- a/Tools__MethodList.st Sat Jan 23 06:59:30 2016 +0100
+++ b/Tools__MethodList.st Sun Jan 24 06:56:35 2016 +0100
@@ -1733,9 +1733,10 @@
].
].
icn isNil ifTrue:[
- (selector isSymbol and:[selector startsWith:'test']) ifTrue:[
- (((cls isSubclassOf:TestCase) and:[cls isAbstract not])
- or:[showSyntheticMethods value and:[aMethod isSynthetic]]) ifTrue:[
+ "/ (selector isSymbol and:[selector startsWith:'test']) ifTrue:[
+ (((cls isSubclassOf:TestCase) and:[cls isAbstract not])
+ or:[showSyntheticMethods value and:[aMethod isSynthetic]]) ifTrue:[
+ (cls isTestSelector:selector) ifTrue:[
"JV@2011-11-17: Show thumbs even if not all test were run"
lastResultOrNil := cls rememberedOutcomeFor:selector.
--- a/Tools__NavigatorModel.st Sat Jan 23 06:59:30 2016 +0100
+++ b/Tools__NavigatorModel.st Sun Jan 24 06:56:35 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
@@ -183,6 +181,9 @@
!
nameListEntryForFailedTests
+ "obsoleted by nameListEntryForTestsNotPassed, because it is unclear what failed test means
+ (any of error, fail, inconc, never run, or only the explicit fail?)"
+
^ '* failed tests (%1) *'
"Created: / 08-03-2010 / 18:26:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -260,6 +261,13 @@
^ '* super (%1) *'
!
+nameListEntryForTestsNotPassed
+ "includes all non-passed states
+ (i.e. fail, error, skipped, inconclusive and never run)"
+
+ ^ '* tests not passed (%1) *'
+!
+
nameListEntryForUncommented
^ '* uncommented (%1) *'
!
@@ -508,11 +516,11 @@
!NavigatorModel class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NavigatorModel.st,v 1.33 2015-05-01 09:00:55 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NavigatorModel.st,v 1.33 2015-05-01 09:00:55 cg Exp $'
+ ^ '$Header$'
!
version_HG
@@ -521,7 +529,7 @@
!
version_SVN
- ^ '$Id: Tools__NavigatorModel.st,v 1.33 2015-05-01 09:00:55 cg Exp $'
+ ^ '$Id$'
! !
--- a/resources/de.rs Sat Jan 23 06:59:30 2016 +0100
+++ b/resources/de.rs Sun Jan 24 06:56:35 2016 +0100
@@ -1305,7 +1305,7 @@
'Implementors' 'Implementierungen'
'Implementors Of' 'Implementierungen von'
'Implementors of' 'Implementierungen von'
-'Implementors of Any' 'Implementierung von irgendeinem'
+'Implementors of Any' 'Implementierungen der Ausgewählten'
'Import' 'Importieren'
'Import "%1" from Directory' 'Importiere "%1" aus Verzeichnis'
'Import Structure' 'Importieren - Struktur'
@@ -2228,7 +2228,7 @@
'Senders' 'Sender'
'Senders Of' 'Sender von'
'Senders of' 'Sender von'
-'Senders of Any' 'Sender von Auswahl'
+'Senders of Any' 'Sender eines der Ausgewählten'
'Services' 'Dienste'
'Serving HTTP Requests' 'HTTP-Dienst bereitstellen'
'Set Selection to Root' 'Setze Selektion zu Root'