--- a/Tools__NewSystemBrowser.st Tue Oct 16 14:26:17 2012 +0200
+++ b/Tools__NewSystemBrowser.st Wed Oct 17 19:37:19 2012 +0200
@@ -7040,47 +7040,40 @@
enabled: hasClassSelectedHolder
label: 'Inspect Class'
itemValue: classMenuInspectClass
- translateLabel: true
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Classes'
itemValue: classMenuInspectClass
- translateLabel: true
isVisible: hasMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Subclasses'
itemValue: classMenuInspectSubclasses
- translateLabel: true
isVisible: hasNotMultipleClassesSelectedHolder
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Instances'
itemValue: classMenuInspectInstances
- translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect Derived Instances'
itemValue: classMenuInspectDerivedInstances
- translateLabel: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Inspect References to Instances'
itemValue: classMenuInspectReferencesToInstances
- translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Lint'
- translateLabel: true
isVisible: false
submenuChannel: lintMenu
keepLinkedMenu: true
@@ -7089,14 +7082,12 @@
enabled: hasClassSelectedHolder
label: 'Recompile all Methods'
itemValue: classMenuRecompile
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
enabled: hasClassSelectedHolder
label: 'Recompile all Methods here and in Subclasses'
itemValue: classMenuRecompileAll
- translateLabel: true
showBusyCursorWhilePerforming: true
)
(MenuItem
@@ -7106,14 +7097,17 @@
enabled: hasClassSelectedAndInstrumentingCompilerExistsHolder
label: 'Recompile all Methods with Instrumentation'
itemValue: classMenuRecompileInstrumented
- translateLabel: true
- showBusyCursorWhilePerforming: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasClassWithInstrumentedMethodsSelected
+ label: 'Clear Coverage Info (Classwide)'
+ itemValue: classMenuClearCoverageInfo
)
(MenuItem
enabled: hasClassSelectedAndInstrumentingCompilerExistsAndOOMPackageLoadedHolder
label: 'Call Graph'
itemValue: debugMenuOpenCallGraphForClasses
- translateLabel: true
showBusyCursorWhilePerforming: true
)
)
@@ -20279,6 +20273,15 @@
"Created: / 4.2.2000 / 22:02:53 / cg"
!
+hasClassWithInstrumentedMethodsSelected
+ self hasAnyClassSelectedForWhich:[:cls |
+ cls instAndClassMethodsDo:[:m |
+ m isInstrumented ifTrue:[^ true].
+ ].
+ ].
+ ^ false
+!
+
hasClassesSelectedAndDataBaseRepositoryExistsHolder
^ [
| classes |
@@ -21809,8 +21812,8 @@
hasTemporaryVariableSelectedInCodeView
"/ |node|
- self codeAspect value ~~ SyntaxHighlighter codeAspectMethod ifTrue:[^ false].
- (self hasSingleWordSelectedInCodeView) ifFalse:[^ false].
+ self codeAspect value ~~ SyntaxHighlighter codeAspectMethod ifTrue:[ ^ false].
+ (self hasSingleWordSelectedInCodeView) ifFalse:[ ^ false].
"/ the following is too slow
"/ node := self findNode.
@@ -22756,7 +22759,7 @@
|codeAspect|
"/ if showing history or log,
- "/ dont update codeView, as long as no protocol is selected
+ "/ don't update codeView, as long as no protocol is selected
((codeAspect := self codeAspect) == #repositoryLog
or:[codeAspect == #repositoryHistory]) ifTrue:[
self hasProtocolSelected ifFalse:[
@@ -22852,7 +22855,6 @@
changedObject == Smalltalk ifTrue:[
codeAspect := self codeAspect.
-
isForAspect := (codeAspect == something)
and:[ something == #classDefinition
or:[ something == #classComment
@@ -22864,12 +22866,14 @@
isForAspect ifTrue:[
((self selectedClassesValue) contains:[:cls | cls name = aParameter name]) ifTrue:[
self enqueueDelayedUpdateCode.
- ]
- ].
+ ^ self.
+ ]
+ ].
+
something == #methodInClass ifTrue:[
- self codeAspect == SyntaxHighlighter codeAspectMethod ifTrue:[
- mthd := self theSingleSelectedMethod.
- (mthd notNil and:[aParameter third == mthd])
+ codeAspect == SyntaxHighlighter codeAspectMethod ifTrue:[
+ mthd := self theSingleSelectedMethod.
+ (mthd notNil and:[aParameter third == mthd])
ifTrue:[
mthd mclass notNil ifTrue:[
"/ mhmh - Smalltalk tells me that a method has changed,
@@ -22877,16 +22881,28 @@
"/ (the methodList seems to be behind me in the dependency chain).
"/ simply ignore this update here (assuming that the methodList will trigger
"/ another change soon).
- self enqueueDelayedUpdateCodeWithoutAutoSearch.
- ].
- ].
- ]
+"/ self enqueueDelayedUpdateCodeWithoutAutoSearch.
+ ] ifFalse:[
+"/ self halt.
+ ].
+ ].
+ ].
+ ^ self
].
something == #methodTrap ifTrue:[
self hasMethodWithoutBreakPointSelectedHolder value:(self hasMethodWithoutBreakPointSelected).
self hasMethodWithBreakPointSelectedHolder value:(self hasMethodWithBreakPointSelected).
- ].
+ ^ self
+ ].
+
+ something == #methodCoverageInfo ifTrue:[
+ self theSingleSelectedMethod == aParameter ifTrue:[
+ self enqueueDelayedUpdateCode.
+ ].
+ ^ self
+ ].
+
^ self
].
@@ -25791,6 +25807,7 @@
self selectedCategoryClassesDo:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
+ self askForGlobalCoverageRecording.
"Created: / 31-05-2012 / 09:15:44 / cg"
!
@@ -27023,6 +27040,15 @@
"Modified: / 21-12-2011 / 20:22:34 / cg"
!
+askForGlobalCoverageRecording
+ self globalCoverageRecordingIsEnabled value ifFalse:[
+ (Dialog confirm:(resources stringWithCRs:'Coverage recording can be done either during a single test-run, or globally for every process.\Currently, global recording is disabled, which means that recording will only be done during a special recording test-run (in the Testrunner tool).\\Do you want to enable global coverage recording now?'))
+ ifTrue:[
+ self debugMenuEnableGlobalCoverageRecording
+ ]
+ ].
+!
+
askForSuperclassToGenerateTestMethod:selector
|newClass newClassName sup initial m
supers list currentClass reqString okLabel title|
@@ -29312,6 +29338,7 @@
self selectedClassesDo:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
+ self askForGlobalCoverageRecording.
"Modified: / 10-08-2010 / 14:36:42 / cg"
!
@@ -30687,12 +30714,49 @@
self showCoverageInformation value:true
].
].
- self globalCoverageRecordingIsEnabled value ifFalse:[
- (Dialog confirm:(resources stringWithCRs:'Coverage recording can be done either during a single test-run, or globally for every process.\Currently, global recording is disabled, which means that recording will only be done during a special recording test-run (in the Testrunner tool).\\Do you want to enable global coverage recording now?'))
- ifTrue:[
- self debugMenuEnableGlobalCoverageRecording
- ].
- ].
+
+ "Created: / 10-08-2010 / 14:36:45 / cg"
+ "Modified: / 31-05-2012 / 10:36:42 / cg"
+!
+
+recompileClassWithInstrumentation:aClass askForGlobalCoverage:doAsk
+ |cls compile|
+
+ "/ cannot compile stuff which the instrumenter itself needs
+ (aClass == IdentityDictionary) ifTrue:[^ self].
+ (aClass == SmallInteger) ifTrue:[^ self].
+
+"/ aClass theNonMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
+"/ aClass theMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
+
+ compile :=
+ [:cls :sel :mthd |
+ ((mthd sends:#subclassResponsibility)
+ or:[ (mthd sends:#subclassResponsibility:) ]) ifFalse:[
+ mthd hasPrimitiveCode ifFalse:[
+ cls recompile:sel usingCompiler:InstrumentingCompiler new
+ ]
+ ]
+ ].
+
+ (cls := aClass theNonMetaclass)
+ selectorsAndMethodsDo:[:aSelector :aMethod |
+ compile value:cls value:aSelector value:aMethod.
+ ].
+
+ (cls := aClass theMetaclass)
+ selectorsAndMethodsDo:[:aSelector :aMethod |
+ aMethod category ~= 'documentation' ifTrue:[
+ compile value:cls value:aSelector value:aMethod.
+ ]
+ ].
+
+ self showCoverageInformation value ifFalse:[
+ true "(Dialog confirm:(resources string:'Turn on coverage display now ?'))" ifTrue:[
+ self showCoverageInformation value:true
+ ].
+ ].
+ doAsk ifTrue:[ self askForGlobalCoverageRecording ].
"Created: / 10-08-2010 / 14:36:45 / cg"
"Modified: / 31-05-2012 / 10:36:42 / cg"
@@ -35861,6 +35925,20 @@
!NewSystemBrowser methodsFor:'menu actions-debug'!
+classMenuClearCoverageInfo
+ "clear coverage information for selected classes"
+
+ self withWaitCursorDo:[
+ self selectedClassesDo:[:cls |
+ InstrumentationInfo allInfosOfClass:cls do:[:info |
+ info cleanInfoWithChange:false
+ ]
+ ].
+ ].
+ Smalltalk changed:#coverageInfo.
+ self showCoverageInformation changed. "/ to force update
+!
+
commonTraceHelperWith:aSelector with:argumentOrNil clear:doClear
"install a break/trace or countPoint for the current method(s)"
@@ -36304,18 +36382,17 @@
First, compile all affected testee-classes with instrumentation,
then run the tests, then open a browser on the tested classes."
- |testedClassNames testedClasses browser|
-
- testedClassNames := Set new.
+ |testedClasses browser|
+
+ testedClasses := Set new.
self selectedNonAbstractTestCaseClassesDo:[:eachClass |
- testedClassNames addAll:(eachClass testedClasses).
- ].
- testedClasses := testedClassNames collect:[:eachClassName | Smalltalk at:eachClassName].
-
+ testedClasses addAll:(eachClass coveredClasses).
+ ].
testedClasses do:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
+ self askForGlobalCoverageRecording.
self runTestCasesWithDebug:false protocols:nil.
browser := self class browseClasses:testedClasses.
@@ -39497,6 +39574,7 @@
self selectedProjectClasses do:[:eachClass |
self recompileClassWithInstrumentation:eachClass
].
+ self askForGlobalCoverageRecording.
"Created: / 27-04-2010 / 12:39:43 / cg"
"Modified: / 30-09-2011 / 12:39:19 / cg"
@@ -42138,7 +42216,7 @@
!
moveOrCopyMethods:methods toClass:newClass moveOrCopy:doWhat
- "move or copy some methods to some other class - typically a sister class"
+ "move or copy some methods to some other class - typically a sister or parent class"
|canUseRefactoringSupport changes nm newClassName|
@@ -42150,7 +42228,9 @@
(doWhat == #moveAndForward)
ifTrue:['Move with Forwarding %1 to %2']
ifFalse:['Move %1 to %2']].
- nm := nm bindWith:(methods size == 1 ifTrue:[methods first whoString] ifFalse:[methods size printString , ' methods'])
+ nm := nm bindWith:(methods size == 1
+ ifTrue:[methods first whoString]
+ ifFalse:[methods size printString , ' methods'])
with:newClass name.
changes := CompositeRefactoryChange named:nm.
].
@@ -42158,7 +42238,7 @@
methods copy do:[:methodToCopyOrMove |
|question msg selectorToCopyOrMove
category source dontDoIt newMethod oldClass
- template|
+ template oldProject|
dontDoIt := false.
selectorToCopyOrMove := methodToCopyOrMove selector.
@@ -42176,8 +42256,8 @@
"/ confirm copy/move of the version method (to avoid confusing the repository)
((AbstractSourceCodeManager isVersionMethodSelector:selectorToCopyOrMove) and:[newClass isMeta]) ifTrue:[
question := (doWhat == #copy)
- ifTrue:['Copying the version method might confuse the repository.\\Copy anyway ?']
- ifFalse:['Moving the version method might confuse the repository.\\Move anyway ?'].
+ ifTrue:['Copying a version method might confuse the repository.\\Copy anyway ?']
+ ifFalse:['Moving a version method might confuse the repository.\\Move anyway ?'].
(self confirm:(resources string:question) withCRs) ifFalse:[
dontDoIt := true
]
@@ -42186,6 +42266,7 @@
dontDoIt ifFalse:[
source := methodToCopyOrMove source.
category := methodToCopyOrMove category.
+ oldProject := methodToCopyOrMove package.
lastMethodMoveClass := newClass name.
@@ -42208,9 +42289,19 @@
self warn:(resources string:msg with:selectorToCopyOrMove)
] ifFalse:[
oldClass := methodToCopyOrMove mclass.
+
+ canUseRefactoringSupport ifTrue:[
+ changes
+ changeProjectOf:selectorToCopyOrMove
+ in:newClass
+ to:oldProject.
+ ] ifFalse:[
+ newMethod package:oldProject.
+ ].
+
(doWhat == #copy) ifFalse:[
canUseRefactoringSupport ifTrue:[
- changes removeMethod: selectorToCopyOrMove from:oldClass
+ changes removeMethod: selectorToCopyOrMove from:oldClass.
] ifFalse:[
oldClass removeSelector:selectorToCopyOrMove.
].
@@ -42233,10 +42324,15 @@
compile:source
in:oldClass
classified:category.
+ changes
+ changeProjectOf:selectorToCopyOrMove
+ in:oldClass
+ to:oldProject.
] ifFalse:[
- oldClass
+ newMethod := oldClass
compile:source
classified:category.
+ newMethod package:oldProject.
].
]
]
@@ -43633,7 +43729,7 @@
!
selectorMenuMoveOrCopy:doWhat
- "move or copy the selected methods to some other class - typically a sister class"
+ "move or copy the selected methods to some other class - typically a sister or parent class"
|newClass methods|
@@ -47199,7 +47295,7 @@
!
codeViewMenu
- "add more functionality to the codeViews text-editor-menu.
+ "add more functionality to the codeView's text-editor-menu.
Get here via the menuHolder-plug in codeView."
<resource: #programMenu>
@@ -50052,30 +50148,26 @@
code := codeString.
-
(codeView := self codeView) notNil ifTrue:[
codeView numberOfLines < 1000 ifTrue:[
shownCode := codeView contents.
].
prevCode := (shownCode ? '') asString.
(codeView modified
- or:[
- (prevCode asText sameStringAndEmphasisAs:(code ? '') asString asText) not
- ]) ifTrue:[
- (prevCode isNil
- or:[code isNil
- or:[(prevCode withTabsExpanded sameStringAndEmphasisAs: code withTabsExpanded) not]]) ifTrue:[
- code = self codeHolder value ifTrue:[
- "/ a reselect without accepting before ...
- "/ sigh - must use setValue, and enforce a change
- "/ (workaround for proceed after changed text-warning)
- self codeHolder setValue:code.
- code = shownCode ifFalse:[
- codeView setContents:code.
- ]
- ] ifFalse:[
- self codeHolder value:code.
- ].
+ or:[ prevCode isNil
+ or:[ code isNil
+ or:[ (prevCode asText sameStringAndEmphasisAs:(code ? '') asString asText) not
+ or:[(prevCode withTabsExpanded sameStringAndEmphasisAs: code withTabsExpanded) not]]]]) ifTrue:[
+ code = self codeHolder value ifTrue:[
+ "/ a reselect without accepting before ...
+ "/ sigh - must use setValue, and enforce a change
+ "/ (workaround for proceed after changed text-warning)
+ self codeHolder setValue:code.
+ "/ code = shownCode ifFalse:[
+ codeView setContents:code.
+ "/ ]
+ ] ifFalse:[
+ self codeHolder value:code.
].
doScrollToTop ifTrue:[
codeView cursorHome.
@@ -50148,7 +50240,6 @@
doSyntaxColoring := self doSyntaxColoring value == true.
].
doAutoFormat := self doAutoFormat value and:[RBFormatter notNil].
-
codeView := self codeView.
self assert:codeView notNil.
@@ -53093,7 +53184,20 @@
]
].
].
- ^ (msg ? '').
+ msg := (msg ? '').
+
+ method isInstrumented ifTrue:[
+ msg := (msg isEmpty
+ ifTrue:['']
+ ifFalse:[msg,' ']) , 'Instrumented'.
+
+ self showCoverageInformation value ifFalse:[
+ msg := msg , ' (coverage display is turned off - see "view"-menu)'
+ ].
+ msg := msg , '.'.
+ ].
+
+ ^ msg.
!
infoStringForClasses:aCollectionOfClasses withPrefix:prefix
@@ -55672,7 +55776,7 @@
ex proceedWith:answer
].
] do:[
- |codeView package oldMethod oldSelector defPackage answer rslt lang|
+ |codeView package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
"/ used to be
"/ oldSelector := self theSingleSelectedSelector.
@@ -55687,6 +55791,7 @@
oldSelector := existingMethod selector
].
].
+ wasInstrumented := oldMethod isInstrumented.
].
"/ check for overwritten version method
@@ -55710,8 +55815,6 @@
"/ to end up in another namespace. In that case, we give a different warning message.
Parser parseErrorSignal catch:[
rslt := language compilerClass
- "/ cg: I am not sure, if this is correct; shouldn' we ask the old method
- "/ for its progLanguage/compilerClass if we accept an old method ???
compile:code
forClass:cls
inCategory:cat
@@ -55857,8 +55960,14 @@
rslt := cls compiledMethodAt:newSelector.
] ifFalse:[
rslt := language compilerClass
- "/ cg: I am not sure, if this is correct; shouldn' we ask the old method
- "/ for its progLanguage/compilerClass if we accept an old method ???
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:codeView
+ install:true.
+ ].
+ wasInstrumented ifTrue:[
+ rslt := InstrumentingCompiler
compile:code
forClass:cls
inCategory:cat
@@ -55870,6 +55979,7 @@
].
].
+
"/ give subcanvases a chance to synchronize ...
"/ self immediateUpdate value:true.
@@ -55879,7 +55989,7 @@
"/ Icon flushCachedIcons
"/ ].
- rslt package.
+ rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
navigationState realModifiedState:false.
codeView modified:false.
@@ -55914,6 +56024,10 @@
doCheck ifTrue:[
self checkAcceptedMethod:rslt inClass:cls.
].
+"/ wasInstrumented ifTrue:[
+"/ self recompileMethodWithInstrumentation:rslt.
+"/ ].
+
returnValue := true.
"/ self updateBufferLabel.
].
@@ -57473,11 +57587,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1788 2012-10-16 12:25:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1789 2012-10-17 17:37:19 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1788 2012-10-16 12:25:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1789 2012-10-17 17:37:19 cg Exp $'
!
version_SVN