--- a/Context.st Wed Feb 19 21:19:59 2014 +0100
+++ b/Context.st Wed Feb 19 21:24:28 2014 +0100
@@ -2528,6 +2528,44 @@
^ true
!
+isReallyRecursive
+ "return true, if this context is one of a recursive send of the same
+ selector AND same argument(s) to the same receiver before.
+ Here, different arguments are NOT ignored"
+
+ |c count "{Class: SmallInteger }" sameArgs|
+
+ count := 0.
+
+ c := self findNextContextWithSelector:selector or:nil or:nil.
+ [c notNil] whileTrue:[
+ (c receiver == receiver) ifTrue:[
+ c method == self method ifTrue:[
+ sameArgs := true.
+ 1 to:self numArgs do:[:i |
+ (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
+ 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
+ ]
+ ].
+ ^ false
+!
+
isRecursive
"return true, if this context is one of a recursive send of the same
selector to the same receiver before.
@@ -2535,7 +2573,7 @@
counts for recursiveness.
Used to detect recursive errors or recursive printing - for example."
- |c count "{Class: SmallInteger }" myMethodsClass|
+ |c count "{Class: SmallInteger }"|
count := 0.
@@ -2576,11 +2614,11 @@
!Context class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.196 2014-02-19 20:19:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.197 2014-02-19 20:24:28 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.196 2014-02-19 20:19:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.197 2014-02-19 20:24:28 cg Exp $'
!
version_HG