From 620f90e845f5b30589ddd6d5556d73b33f3fb342 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs@noemail.net>
Date: Tue, 11 Sep 2001 00:46:35 +0000
Subject: 	* tests/stack.test: 	* generic/tclInterp.c (AliasObjCmd):
 Check the numLevels to ensure 	that we aren't hitting some alias loop
 condition.  [Bug #443184]

FossilOrigin-Name: 09e3192250ad58a483513bdc5f756c54db8820a3
---
 generic/tclInterp.c | 21 +++++++++++++++++----
 tests/stack.test    | 10 +++++++++-
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 106bf50..fcc27bd 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.6 2001/04/04 07:11:01 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.7 2001/09/11 00:46:35 hobbs Exp $
  */
 
 #include <stdio.h>
@@ -1398,6 +1398,19 @@ AliasObjCmd(clientData, interp, objc, objv)
     Tcl_AllowExceptions(targetInterp);
 
     /*
+     * Check depth of nested calls with AliasObjCmd: if this gets too large,
+     * it's probably because of an infinite loop somewhere.
+     */
+
+    if (((Interp *) targetInterp)->numLevels >
+	    ((Interp *) targetInterp)->maxNestingDepth) {
+	Tcl_AppendToObj(Tcl_GetObjResult(targetInterp),
+		"too many nested calls to AliasObjCmd (infinite loop using alias?)", -1);
+	result = TCL_ERROR;
+	goto done;
+    }
+
+    /*
      * Append the arguments to the command prefix and invoke the command
      * in the target interp's global namespace.
      */
@@ -1410,8 +1423,6 @@ AliasObjCmd(clientData, interp, objc, objv)
 	    TCL_INVOKE_NO_TRACEBACK);
     Tcl_DecrRefCount(cmdPtr);
 
-    ((Interp *) targetInterp)->numLevels--;
-    
     /*
      * Check if we are at the bottom of the stack for the target interpreter.
      * If so, check for special return codes.
@@ -1441,7 +1452,9 @@ AliasObjCmd(clientData, interp, objc, objv)
 	    result = TCL_ERROR;
 	}
     }
-
+    done:
+    ((Interp *) targetInterp)->numLevels--;
+    
     TclTransferResult(targetInterp, result, interp);
 
     Tcl_Release((ClientData) targetInterp);
diff --git a/tests/stack.test b/tests/stack.test
index 9176201..1d1bdce 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stack.test,v 1.9 2000/09/29 21:42:35 hobbs Exp $
+# RCS: @(#) $Id: stack.test,v 1.10 2001/09/11 00:46:35 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -45,6 +45,14 @@ test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
     set rv
 } {too many nested calls to Tcl_EvalObj (infinite loop?)}
 
+test stack-2.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
+    catch {rename unknown unknown_safe}
+    interp alias {} unknown {} notaknownproc
+    catch {foo} msg
+    catch {rename unknown {} ; rename unknown_safe unknown}
+    set msg
+} {too many nested calls to AliasObjCmd (infinite loop using alias?)}
+
 # cleanup
 ::tcltest::cleanupTests
 return
-- 
cgit v0.12