--- a/Context.st Fri Sep 15 17:11:53 2017 +0200
+++ b/Context.st Sun Sep 17 10:03:41 2017 +0200
@@ -16,7 +16,7 @@
Object variableSubclass:#Context
instanceVariableNames:'flags sender* home receiver selector searchClass method lineNr
retvalTemp handle*'
- classVariableNames:'SingleStepInterruptRequest'
+ classVariableNames:'SingleStepInterruptRequest MaxRecursion'
poolDictionaries:''
category:'Kernel-Methods'
!
@@ -169,12 +169,17 @@
CannotResumeError notifierString:'invalid resume'.
SingleStepInterruptRequest isNil ifTrue:[
- SingleStepInterruptRequest := QuerySignal new.
- SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
- SingleStepInterruptRequest notifierString:'single step'.
- ]
-
- "Modified: 6.5.1996 / 16:46:03 / cg"
+ SingleStepInterruptRequest := QuerySignal new.
+ SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
+ SingleStepInterruptRequest notifierString:'single step'.
+ ].
+
+ "/ context searchers (eg. isRecursive) will stop searching after
+ "/ this many call levels and assume, that something is wrong with the
+ "/ calling chain.
+ MaxRecursion := 10000.
+
+ "Modified: / 17-09-2017 / 10:00:19 / cg"
! !
!Context class methodsFor:'Signal constants'!
@@ -3000,20 +3005,22 @@
count := 0.
- c := self findNextContextWithSelector:selector or:nil or:nil.
- [c notNil] whileTrue:[
+ c := self.
+ [
+ c := c findNextContextWithSelector:selector or:nil or:nil.
+ c notNil
+ ] whileTrue:[
(c receiver == receiver) ifTrue:[
c method == self method ifTrue:[
sameArgs := true.
1 to:self argumentCount do:[:i |
- (c argAt:1) ~~ (self argAt:i)ifTrue:[
+ (c argAt:1) ~~ (self argAt:i) ifTrue:[
sameArgs := false
]
].
sameArgs ifTrue:[^ true].
]
].
- c := c findNextContextWithSelector:selector or:nil or:nil.
"
this special test was added to get out after a while
@@ -3021,12 +3028,14 @@
a chance to find those errors.
"
count := count + 1.
- count >= 100000 ifTrue:[
- 'Context [warning]: bad context chain' errorPrintCR.
+ count >= MaxRecursion ifTrue:[
+ 'Context [warning]: long context chain' errorPrintCR.
^ true
]
].
^ false
+
+ "Modified: / 17-09-2017 / 10:00:34 / cg"
!
isRecursive
@@ -3040,38 +3049,29 @@
count := 0.
- c := self findNextContextWithSelector:selector or:nil or:nil.
- [c notNil] whileTrue:[
- (c receiver == receiver) ifTrue:[
-"/ "
-"/ stupid: the current ST/X context does not include
-"/ the method, but the class, in which the search started ...
-"/ "
-"/ myMethodsClass isNil ifTrue:[
-"/ myMethodsClass := self methodClass.
-"/ ].
-"/ c methodClass == myMethodsClass ifTrue:[
-"/ ^ true
-"/ ].
- "/ now it does!!
- c method == self method ifTrue:[^ true].
- ].
- c := c findNextContextWithSelector:selector or:nil or:nil.
-
- "
- this special test was added to get out after a while
- if the sender chain is corrupt - this gives us at least
- a chance to find those errors.
- "
- count := count + 1.
- count >= 100000 ifTrue:[
- 'Context [warning]: bad context chain' errorPrintCR.
- ^ true
- ]
+ c := self.
+ [
+ c := c findNextContextWithSelector:selector or:nil or:nil.
+ c notNil
+ ] whileTrue:[
+ (c receiver == receiver) ifTrue:[
+ c method == self method ifTrue:[^ true].
+ ].
+
+ "
+ this special test was added to get out after a while
+ if the sender chain is corrupt - this gives us at least
+ a chance to find those errors.
+ "
+ count := count + 1.
+ count >= MaxRecursion ifTrue:[
+ 'Context [warning]: long context chain' errorPrintCR.
+ ^ true
+ ]
].
^ false
- "Modified: 10.1.1997 / 17:34:26 / cg"
+ "Modified (format): / 17-09-2017 / 10:02:04 / cg"
! !
!Context class methodsFor:'documentation'!