diff options
| -rw-r--r-- | generic/tclInterp.c | 21 | ||||
| -rw-r--r-- | 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 |