hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:b4a144ee8154
+:948821582e7f
 	category:'Interface-Debugger'
 !
 Object subclass:#IgnoredHaltOrBreakpoint
 	instanceVariableNames:'ignoreEndTime ignoreCount ignoreUntilShiftKeyPressed
-		ignoredReceiverClasses ignoredProcesses'
+		ignoredReceiverClasses ignoredProcesses
+		ignoredSendingClassAndSelectors'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:DebugView
 !
 hasIgnoredHalts
 self removeInactiveIgnores.
 ^ IgnoredHalts notEmptyOrNil
 !
-ignoreBreakpointWithParameter:parameterOrNil forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey orReceiverClass:receiverClassOrNil orProcess:processOrNil
+ignoreBreakpointWithParameter:parameterOrNil
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
 "remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations
 or until some time has elapsed.
 With nil count and time arguments, such an ignored breakpoint is reactivated"
 self
 ignoreHaltOrBreakpoint:#halt
 method:nil line:nil
 parameter:parameterOrNil
 forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
 orReceiverClass:receiverClassOrNil orProcess:processOrNil
-!
+orIfCalledFromMethod:nil
+!
-ignoreHaltIn:haltingMethod at:lineNrOfHalt forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey orReceiverClass:receiverClassOrNil orProcess:processOrNil
+ignoreHaltIn:haltingMethod at:lineNrOfHalt
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
 "remember to ignore a halt in some method for some number of invocations
 or until some time has elapsed.
 With nil count and time arguments, such an ignored halt is reactivated"
 self
 ignoreHaltOrBreakpoint:#halt
 method:haltingMethod line:lineNrOfHalt
 parameter:nil
 forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
 orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:nil
+!
+ignoreHaltIn:haltingMethod at:lineNrOfHalt
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:ifCalledForMethodOrNil
+"remember to ignore a halt in some method for some number of invocations
+or until some time has elapsed.
+With nil count and time arguments, such an ignored halt is reactivated"
+self
+ignoreHaltOrBreakpoint:#halt
+method:haltingMethod line:lineNrOfHalt
+parameter:nil
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:ifCalledForMethodOrNil
 !
 ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil
 forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
 orReceiverClass:receiverClassOrNil orProcess:processOrNil
+"remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations
+or until some time has elapsed.
+With nil count and time arguments, such an ignored breakpoint is reactivated"
+^ self
+ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:nil
+!
+ignoreHaltOrBreakpoint:type method:methodOrNil line:lineNrOfHaltOrNil parameter:parameterOrNil
+forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:ifCalledFromMethodOrNil
 "remember to ignore a breakpoint with a parameter (i.e. breakpoint:#cg) for some number of invocations
 or until some time has elapsed.
 With nil count and time arguments, such an ignored breakpoint is reactivated"
 (countOrNil notNil
 or:[dTOrNil notNil
 or:[untilShiftKey == true
 or:[receiverClassOrNil notNil
-or:[processOrNil notNil]]]]
+or:[processOrNil notNil
+or:[ifCalledFromMethodOrNil notNil]]]]]
 ) ifTrue:[
 IgnoredHalts isNil ifTrue:[
 IgnoredHalts := OrderedCollection new.
 ].
 type == #halt ifTrue:[
 receiverClassOrNil notNil ifTrue:[
 ign ignoreForReceiverClass:receiverClassOrNil.
 ].
 processOrNil notNil ifTrue:[
 ign ignoreForProcess:processOrNil.
+].
+ifCalledFromMethodOrNil notNil ifTrue:[
+ign ignoreIfCalledFromMethod:ifCalledFromMethodOrNil.
 ].
 IgnoredHalts add:ign.
 ].
 Smalltalk changed:#ignoredHalts.
 )
 (MenuItem
 enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped
 label: 'For this Receiver Class'
 itemValue: ignoreHaltForThisReceiverClass
+)
+(MenuItem
+enabled: isStoppedAtHaltOrBreakPointOrSelectedContextIsWrapped
+label: 'If Called from Any Of'
+submenuChannel: menuForIgnoreBreakpointIfCalledFromAnyOf
 )
 )
 nil
 nil
 )
 !
 ignoreAllHaltsForever
 self
 addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:true.
 "Created: / 08-05-2011 / 10:19:56 / cg"
 !
 ignoreAllHaltsUntilShiftKeyIsPressed
 self
 addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:true.
 "Created: / 27-01-2012 / 11:32:14 / cg"
 !
 ignoreBreakpointsWithThisParameterUntilShiftKeyIsPressed
 self
 addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 "Created: / 06-03-2012 / 12:35:22 / cg"
 !
 ignoreHaltForCurrentProcess
 self
 addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:true
+orIfCalledFromMethod:nil
 forAll:false.
 "Created: / 27-01-2012 / 11:32:14 / cg"
 !
 ignoreHaltForThisReceiverClass
 self
 addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:true orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 "Created: / 27-01-2012 / 11:32:14 / cg"
 !
 ignoreHaltForever
 self
 addIgnoredHaltForCount:-1 orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 "Modified: / 27-01-2012 / 11:31:37 / cg"
+!
+ignoreHaltIfCalledFromMethod:aMethod
+self
+addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:false
+orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:aMethod
+forAll:false.
 !
 ignoreHaltUntilShiftKeyIsPressed
 self
 addIgnoredHaltForCount:nil orTimeDuration:nil orUntilShiftKey:true
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 "Created: / 27-01-2012 / 11:36:54 / cg"
+!
+menuForIgnoreBreakpointIfCalledFromAnyOf
+<resource: #programMenu >
+|m count already|
+m := Menu new.
+count := 0.
+already := IdentitySet new.
+contextArray do:[:con |
+|mthd cls sel|
+mthd := con method.
+mthd notNil ifTrue:[
+mthd isWrapped ifFalse:[
+(already includes:already) ifFalse:[
+already add:mthd.
+m addItem:(MenuItem
+label: (mthd whoString)
+itemValue: [ self ignoreHaltIfCalledFromMethod:mthd ]
+translateLabel: false).
+count := count + 1.
+(count > 20) ifTrue:[
+^ m
+].
+]
+]
+]
+].
+^ m
 !
 openBreakPointBrowser
 Tools::BreakpointBrowser open
 dT notNil ifTrue:[
 LastIgnoreHaltDuration := dT.
 self
 addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:true.
 ^ self.
 ].
 ] loop
 n notNil ifTrue:[
 LastIgnoreHaltNTimes := n.
 self
 addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 ^ self.
 ].
 ] loop.
 dT notNil ifTrue:[
 LastIgnoreHaltDuration := dT.
 self
 addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 ^ self.
 ].
 ] loop
 n notNil ifTrue:[
 LastIgnoreHaltNTimes := n.
 self
 addIgnoredHaltForCount:n orTimeDuration:nil orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 ^ self.
 ].
 ] loop.
 dT notNil ifTrue:[
 LastIgnoreHaltDuration := dT.
 self
 addIgnoredHaltForCount:nil orTimeDuration:dT orUntilShiftKey:false
 orThisReceiverClass:false orCurrentProcess:false
+orIfCalledFromMethod:nil
 forAll:false.
 ^ self.
 ].
 ] loop
 setOfHiddenCallingSelectors := aCollectionOfSymbols
 ! !
 !DebugView methodsFor:'private-breakpoints'!
-addIgnoredHaltForCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
+addIgnoredHaltForCount:countOrNil
-orThisReceiverClass:forThisReceiverClass orCurrentProcess:forCurrentProcess
+orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
-forAll:aBoolean
+orThisReceiverClass:forThisReceiverClass orCurrentProcess:forCurrentProcess
+orIfCalledFromMethod:ifCalledForMethodOrNil
+forAll:aBoolean
 |haltingContext haltingMethod lineNrOfHalt receiverClassOrNil processOrNil|
 aBoolean ifTrue:[
 haltingMethod := #all
 ] ifFalse:[
 self class
 ignoreHaltIn:haltingMethod at:lineNrOfHalt
 forCount:countOrNil orTimeDuration:dTOrNil orUntilShiftKey:untilShiftKey
 orReceiverClass:receiverClassOrNil orProcess:processOrNil
+orIfCalledFromMethod:ifCalledForMethodOrNil
 "Created: / 27-01-2012 / 11:31:12 / cg"
 !
 canAddBreakpoint
 ignoredReceiverClasses := WeakIdentitySet new.
 ].
 ignoredReceiverClasses add:aClass
 !
+ignoreIfCalledFromMethod:aMethod
+ignoredSendingClassAndSelectors isNil ifTrue:[
+ignoredSendingClassAndSelectors := OrderedCollection new.
+].
+"/ remember the method's name, not the method.
+"/ so it can be recompiled and we still detect ignores
+ignoredSendingClassAndSelectors add:{aMethod mclass name . aMethod selector }
+!
 ignoreUntilShiftKeyPressed:aBoolean
 ignoreUntilShiftKeyPressed := aBoolean.
 "Created: / 27-01-2012 / 11:35:23 / cg"
 ! !
 ! !
 !DebugView::IgnoredHaltOrBreakpoint methodsFor:'printing'!
 printConditionOn:aStream
+ignoredSendingClassAndSelectors notEmptyOrNil ifTrue:[
+aStream nextPutAll:(' if called from %1 >> %2'
+bindWith:ignoredSendingClassAndSelectors first first
+with:ignoredSendingClassAndSelectors first second).
+^ self.
+].
 ignoredProcesses notEmptyOrNil ifTrue:[
 aStream nextPutAll:(' in %1 processes (%2)'
 bindWith:ignoredProcesses size
 with:((ignoredProcesses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')).
-] ifFalse:[
+^ self.
-ignoredReceiverClasses notNil ifTrue:[
+].
-aStream nextPutAll:(' for %1 classes (%2)'
+ignoredReceiverClasses notNil ifTrue:[
-bindWith:ignoredReceiverClasses size
+aStream nextPutAll:(' for %1 classes (%2)'
-with:((ignoredReceiverClasses collect:[:each | each name] as:OrderedCollection) asStringWith:', '))
+bindWith:ignoredReceiverClasses size
-] ifFalse:[
+with:((ignoredReceiverClasses collect:[:each | each name] as:OrderedCollection) asStringWith:', ')).
-ignoreUntilShiftKeyPressed == true ifTrue:[
+^ self.
-aStream nextPutAll:' until shiftKey pressed'.
+].
-] ifFalse:[
+ignoreUntilShiftKeyPressed == true ifTrue:[
-ignoreEndTime notNil ifTrue:[
+aStream nextPutAll:' until shiftKey pressed'.
-aStream nextPutAll:' until '.
+^ self.
-ignoreEndTime printOn:aStream.
+].
-] ifFalse:[
+ignoreEndTime notNil ifTrue:[
-(ignoreCount notNil) ifTrue:[
+aStream nextPutAll:' until '.
-(ignoreCount > 0) ifTrue:[
+ignoreEndTime printOn:aStream.
-aStream nextPutAll:' for '.
+^ self.
-ignoreCount printOn:aStream.
+].
-] ifFalse:[
+(ignoreCount notNil) ifTrue:[
-(ignoreCount < 0) ifTrue:[
+(ignoreCount > 0) ifTrue:[
-aStream nextPutAll:' forEver'.
+aStream nextPutAll:' for '.
-] ifFalse:[
+ignoreCount printOn:aStream.
-aStream nextPutAll:' no longer'.
+^ self.
 ].
-].
+(ignoreCount < 0) ifTrue:[
-]
+aStream nextPutAll:' forEver'.
-].
+^ self.
 ].
-].
+aStream nextPutAll:' no longer'.
 ].
-"Modified: / 27-01-2012 / 11:43:10 / cg"
-"Created: / 06-03-2012 / 12:41:10 / cg"
 ! !
 !DebugView::IgnoredHaltOrBreakpoint methodsFor:'queries'!
 haltIgnoredInfoString
 "/    Transcript showCR:ignoredProcesses.
 "/    Transcript showCR:Processor activeProcess.
 ignoredProcesses notNil ifTrue:[
 ^ ignoredProcesses includes:(Processor activeProcess)
 ].
+ignoredSendingClassAndSelectors notNil ifTrue:[
-^ self isHaltIgnored
+context withAllSendersDo:[:each |
+|m className selector cls|
+(m := each method) notNil ifTrue:[
+cls := m mclass.
+cls notNil ifTrue:[
+className := cls name.
+selector := m selector.
+(ignoredSendingClassAndSelectors contains:[:entry | entry first = className and:[entry second = selector]])
+ifTrue:[^ true].
+].
+]
+]
+].
+^ self isHaltIgnored  "/ unconditionally
 ! !
 !DebugView::IgnoredBreakpoint methodsFor:'accessing'!
 parameter
 ! !
 !DebugView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.659 2014-07-01 20:01:16 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.660 2014-07-08 15:20:38 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.659 2014-07-01 20:01:16 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.660 2014-07-08 15:20:38 cg Exp $'
 !
 version_SVN
-^ '$Id: DebugView.st,v 1.659 2014-07-01 20:01:16 cg Exp $'
+^ '$Id: DebugView.st,v 1.660 2014-07-08 15:20:38 cg Exp $'
 ! !
 DebugView initialize!

changeset 14608	948821582e7f
parent 14559	1de1084ebbd9
child 14640	692dba3782da