#BUGFIX by cg
class: CascadeNode
changed: #codeForCascadeOn:inBlock:for:
avoid recursion error when encoding long cascades...
--- a/CascadeNode.st Tue Aug 08 17:41:14 2017 +0200
+++ b/CascadeNode.st Tue Aug 08 18:08:03 2017 +0200
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libcomp' }"
+"{ NameSpace: Smalltalk }"
+
MessageNode subclass:#CascadeNode
instanceVariableNames:''
classVariableNames:''
@@ -88,9 +90,34 @@
!CascadeNode methodsFor:'code generation'!
codeForCascadeOn:aStream inBlock:b for:aCompiler
- receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+ "the old code could lead to a recursion error with
+ long cascades;
+ the new code does not."
+
+ "/ old
+ "/ receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+ "/ aStream nextPut:#dup.
+ "/ self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+
+ "/ new
+ |leftMostExpression sequence|
+
+ leftMostExpression := receiver.
+ sequence := OrderedCollection new.
+ [ leftMostExpression isCascade ] whileTrue:[
+ sequence addFirst:leftMostExpression.
+ leftMostExpression := leftMostExpression receiver.
+ ].
+
+ leftMostExpression codeForCascadeOn:aStream inBlock:b for:aCompiler.
+ sequence do:[:eachCascade |
+ aStream nextPut:#dup.
+ eachCascade codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+ ].
aStream nextPut:#dup.
- self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+ self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+
+ "Modified: / 08-08-2017 / 18:04:48 / cg"
!
codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -251,10 +278,10 @@
!CascadeNode class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.32 2013-04-25 13:10:46 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.32 2013-04-25 13:10:46 stefan Exp $'
+ ^ '$Header$'
! !