fix: function and arg size book-keeping for TestSub recursion

check/fixes.frm

@@ -2863,6 +2863,16 @@ Print;
 assert succeeded?
 assert result("F") =~ expr("f(x**2) + f(x)**2")
 *--#] Issue359 : 
+*--#[ Issue367 :
+* replace_ corruption in nested multi-argument functions
+Function f,I;
+S s1,s2,s3;
+L F = I(f(s1+2,s2,s3))*replace_(s1,0);
+P;
+.end
+assert succeeded?
+assert result("F") =~ expr("I(f(2,s2,s3))")
+*--#] Issue367 :
 *--#[ Issue400 :
 * denominators statement for nested functions
 S x;
@@ -4340,6 +4350,187 @@ Print;
 assert succeeded?
 assert result("expr") =~ expr("indhide(e_(N1_?,N2_?,N3_?,N4_?))*v1(N1_?)*v2(N2_?)*v3(N3_?)*v4(N4_?)")
 *--#] Issue710_5 :
+*--#[ Issue741_1 :
+* Crash or hang with replace_(x,0) in nested functions
+CF f,g,f1,...,f4;
+S x,y;
+
+L F1 = f(g(x))*replace_(x,0);
+L F2 = f(g(-x))*replace_(x,1);
+L F3 = f(g(-x))*replace_(x,0);
+L F4 = f(g(x+y))*replace_(x,0);
+L F5 = f1(f2(f3(x*f4(x+y))))*replace_(x,0);
+L F6 = f(x+g(-x))*replace_(x,0);
+P;
+.end
+assert succeeded?
+assert result("F1") =~ expr("f(g(0))")
+assert result("F2") =~ expr("f(g(-1))")
+assert result("F3") =~ expr("f(g(0))")
+assert result("F4") =~ expr("f(g(y))")
+assert result("F5") =~ expr("f1(f2(f3(0)))")
+assert result("F6") =~ expr("f(g(0))")
+*--#] Issue741_1 :
+*--#[ Issue741_2 :
+#-
+Off Statistics;
+
+CFunction f1,...,f3;
+Symbol x,y,z;
+Vector k1,k2,p1,p2,p3;
+
+#procedure genterms(a1,a2,a3)
+	+ f1(`a1')
+	+ f1(f2(`a2'))
+	+ f1(f2(f3(`a3')))
+
+	+ f1(`a1'+f2(`a2'))
+	+ f1(`a1'+f2(`a2'+f3(`a3')))
+
+	+ f1(`a1'*f2(`a2'))
+	+ f1(`a1'*f2(`a2'*f3(`a3')))
+
+	+ f1(`a1')^2
+	+ f1(`a1'+f2(`a2')^2)^2
+	+ f1(`a1'+f2(`a2'+f3(`a3')^2)^2)^2
+
+	+ f1(`a1'+`a2'*f2(`a3'))
+
+	+ f1(`a1',f2(`a2'),f2(f3(`a3')))
+	+ f1(f2(f3(`a3')),f2(`a2'),`a1')
+#endprocedure
+
+#define ARGS "10"
+Local arg0 = 1;
+Local arg1 = x;
+Local arg2 = -x;
+Local arg3 = y;
+Local arg4 = -y;
+Local arg5 = x+y;
+Local arg6 = k1.k1;
+Local arg7 = -k1.k1;
+Local arg8 = p1-p2;
+Local arg9 = p1-p3;
+Local arg10 = z^5;
+
+* Generate a large number of nested functions of various arguments.
+* Then make replacements of the the arguments. We generate duplicates
+* of the same terms a lot, but they merge quickly in the sort.
+Local test =
+	#do a1 = 0,`ARGS'
+	#do a2 = 0,`ARGS'
+	#do a3 = 0,`ARGS'
+		#call genterms((arg`a1'),(arg`a2'),(arg`a3'))
+	#enddo
+	#enddo
+	#enddo
+	;
+.sort
+
+#message Make replacements:
+Multiply replace_(x,0);
+Multiply replace_(y,12345);
+Multiply replace_(k1,4321*k2);
+Multiply replace_(p1,p2);
+Multiply replace_(p3,k1-k2);
+Multiply replace_(z,1000000);
+.sort
+
+* The "arg" expressions have had their content replaced directly, so subtract
+* the same set of terms, with the final arguments already in place:
+Local diff = test - (
+	#do a1 = 0,`ARGS'
+	#do a2 = 0,`ARGS'
+	#do a3 = 0,`ARGS'
+		#call genterms((arg`a1'),(arg`a2'),(arg`a3'))
+	#enddo
+	#enddo
+	#enddo
+	);
+
+Print diff;
+.end
+#require wordsize == 4
+assert succeeded?
+assert result("diff") =~ expr("0")
+*--#] Issue741_2 :
+*--#[ Issue741_3a :
+#-
+#: FunctionLevels 31
+
+#define DEPTH "30"
+
+Off Statistics;
+
+CFunction f,f1,...,f`DEPTH';
+Symbol x,y;
+
+Local test = replace_(x,0)*
+	#do i = 1,`DEPTH'
+		f`i'(
+	#enddo
+			y*f(x+y)
+	#do i = 1,`DEPTH'
+		)
+	#enddo
+	;
+
+Local expected =
+	#do i = 1,`DEPTH'
+		f`i'(
+	#enddo
+			0
+	#do i = 1,`DEPTH'
+		)
+	#enddo
+	;
+.sort
+
+Local diff = replace_(y,0)*test - expected;
+
+Print diff;
+.end
+assert succeeded?
+assert result("diff") =~ expr("0")
+*--#] Issue741_3a :
+*--#[ Issue741_3b :
+#-
+#: FunctionLevels 30
+
+#define DEPTH "30"
+
+Off Statistics;
+
+CFunction f,f1,...,f`DEPTH';
+Symbol x,y;
+
+Local test = replace_(y,0)*
+	#do i = 1,`DEPTH'
+		f`i'(
+	#enddo
+			y*f(x+y)
+	#do i = 1,`DEPTH'
+		)
+	#enddo
+	;
+
+Local expected =
+	#do i = 1,`DEPTH'
+		f`i'(
+	#enddo
+			0
+	#do i = 1,`DEPTH'
+		)
+	#enddo
+	;
+.sort
+
+Local diff = replace_(x,0)*test - expected;
+
+Print diff;
+.end
+assert compile_error?("FunctionLevels limit (30) reached. Increase in setup.")
+*--#] Issue741_3b :
 *--#[ Issue747_1 :
 #-
 Off Statistics;

sources/proces.c

@@ -695,6 +695,7 @@ WORD TestSub(PHEAD WORD *term, WORD level)
 	TABLES T;
 	COMPARE oldcompareroutine = (COMPARE)(AR.CompareRoutine);
 	WORD oldsorttype = AR.SortType;
+	const WORD oldRecFlag = AT.RecFlag;
 ReStart:
 	tbufnum = 0; i = 0; retvalue = 0;
 	AT.TMbuff = AM.rbufnum;
@@ -1594,29 +1595,28 @@ doesnotwork:;
 					if ( *t > 0 && t[1] ) {	/* Argument is dirty  */
 						AT.NestPoin->argsize = t;
 						AT.NestPoin++;
-/*						stop = t + *t; */
+						if ( AT.NestPoin - AT.Nest >= AM.maxFlevels ) {
+							MLOCK(ErrorMessageLock);
+							// When we read maxFlevels from the setup, we add 1. So print
+							// maxFlevels-1 here, so that the error message does not appear
+							// inconsistent with what the user might have set.
+							MesPrint("&FunctionLevels limit (%d) reached. Increase in setup.",
+								AM.maxFlevels-1);
+							MUNLOCK(ErrorMessageLock);
+							Terminate(-1);
+						}
 						t2 = t;
 						t += ARGHEAD;
 						while ( t < AT.NestPoin[-1].argsize+*(AT.NestPoin[-1].argsize) ) {
-											/* Sum over terms */
+							/* Sum over terms */
 							AT.RecFlag++;
 							i = *t;
 							AN.subsubveto = 1;
-/*
-							AN.subsubveto repairs a bug that became apparent
-							in an example by York Schroeder:
-								f(k1.k1)*replace_(k1,2*k2)
-							Is it possible to repair the counting of the various
-							length indicators? (JV 1-jun-2010)
-*/
 							if ( ( retvalue = TestSub(BHEAD t,level) ) != 0 ) {
-/*
-								Possible size changes:
-								Note defs at 471,467,460,400,425,328
-*/
-redosize:
 								if ( i > *t ) {
-/*
+									// The term became shorter. Fix the sizes at the current
+									// level of nesting. Outer levels will each be fixed as
+									// we leave the TestSub recursion.
 									i -= *t;
 									*t2 -= i;
 									t1[1] -= i;
@@ -1625,21 +1625,15 @@ doesnotwork:;
 									m = term + *term;
 									while ( r < m ) *t++ = *r++;
 									*term -= i;
-*/
-									i -= *t;
-									t += *t;
-									r = t + i;
-									m = AN.EndNest;
-									while ( r < m ) *t++ = *r++;
-									t = AT.NestPoin[-1].argsize + ARGHEAD;
-									n = AT.Nest;
-									while ( n < AT.NestPoin ) {
-										*(n->argsize) -= i;
-										*(n->funsize) -= i;
-										*(n->termsize) -= i;
-										n++;
-									}
-									AN.EndNest -= i;
+								}
+								else if ( i < *t ) {
+									// The term became longer. Can this ever happen? The code
+									// here has never handled the case where TestSub increases
+									// the size of the term.
+									MLOCK(ErrorMessageLock);
+									MesPrint("TestSub: term size increased during recursion.");
+									MUNLOCK(ErrorMessageLock);
+									Terminate(-1);
 								}
 								AN.subsubveto = 0;
 								t1[2] = 1;
@@ -1653,47 +1647,19 @@ doesnotwork:;
 								DONE(retvalue)
 							}
 							else {
-								/*
-								 * Somehow the next line fixes Issue #106.
-								 */
-								i = *t;
-								Normalize(BHEAD t);
-/*								if ( i > *t ) { retvalue = 1; goto redosize; } */
-								/*
-								 * Experimentally, the next line fixes Issue #105.
-								 */
-								if ( *t == 0 ) { retvalue = 1; goto redosize; }
-								{
-									WORD *tend = t + *t, *tt = t+1;
-									stilldirty = 0;
-									tend -= ABS(tend[-1]);
-									while ( tt < tend ) {
-										if ( *tt == SUBEXPRESSION || *tt == EXPRESSION ) {
-											stilldirty = 1; break;
-										}
-										tt += tt[1];
-									}
-								}
-								if ( i > *t ) {
-/*
-									We should not forget to correct the Nest
-									stack. That caused trouble in the past.
-*/
-									retvalue = 1;
-									i -= *t;
-									t += *t;
-									r = t + i;
-									m = AN.EndNest;
-									while ( r < m ) *t++ = *r++;
-									t = AT.NestPoin[-1].argsize + ARGHEAD;
-									n = AT.Nest;
-									while ( n < AT.NestPoin ) {
-										*(n->argsize) -= i;
-										*(n->funsize) -= i;
-										*(n->termsize) -= i;
-										n++;
+								// For a long time, Normalize was called in-place here. This was
+								// very dangerous, since Normalize can increase the size of the
+								// term, and overwrite term data at outer nesting levels. We
+								// can instead just rely on the Normalize call (which uses the
+								// WorkSpace) just before calling StoreTerm later.
+								WORD *tend = t + *t, *tt = t+1;
+								stilldirty = 0;
+								tend -= ABS(tend[-1]);
+								while ( tt < tend ) {
+									if ( *tt == SUBEXPRESSION || *tt == EXPRESSION ) {
+										stilldirty = 1; break;
 									}
-									AN.EndNest -= i;
+									tt += tt[1];
 								}
 							}
 							AN.subsubveto = 0;
@@ -1704,7 +1670,9 @@ doesnotwork:;
 /*
 						Argument contains no subexpressions.
 						It should be normalized and sorted.
-						The main problem is the storage.
+						The main problem is the storage: we need to Normalize a copy of the
+						term data in the WorkSpace, since Normalize can increase the size
+						of the term, which would overwrite the data which follows!
 */
 						t = AT.NestPoin->argsize;
 						j = *t;
@@ -2132,6 +2100,13 @@ NextFun:;
 		TermFree(Tpattern,"Tpattern");
 		Tpattern = 0;
 	}
+	if ( AT.RecFlag != oldRecFlag ) {
+		MLOCK(ErrorMessageLock);
+		// Internal error
+		MesPrint("Error in TestSub: bookkeeping problem in RecFlag");
+		MUNLOCK(ErrorMessageLock);
+		Terminate(-1);
+	}
 	return(retvalue);
 EndTest:;
 	MLOCK(ErrorMessageLock);