diff options
| -rw-r--r-- | ChangeLog | 19 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 36 |
2 files changed, 43 insertions, 12 deletions
@@ -1,20 +1,25 @@ +2010-03-24 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the + [try] command does not trap unwinding due to limits. + 2010-03-24 Don Porter <dgp@users.sourceforge.net> - * generic/tclCmdMZ.c: [Bug 2973361] Revised fix for computing + * generic/tclCmdMZ.c: [Bug 2973361]: Revised fix for computing indices of script arguments to [try]. 2010-03-23 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tclCmdMZ.c Make error message in "try" implementation - * generic/tclCompCmdsSZ.c exactly the same as the one in "return" - * tests/error.test - * libtommath/mtests/mpi.c Single "const" addition + * generic/tclCmdMZ.c: Make error message in "try" implementation + * generic/tclCompCmdsSZ.c: exactly the same as the one in "return" + * tests/error.test: + * libtommath/mtests/mpi.c: Single "const" addition 2010-03-22 Don Porter <dgp@users.sourceforge.net> * generic/tclCmdMZ.c: [Bug 2973361]: Compute the correct integer - values to identify the argument indices of the various script arguments - to [try]. Passing in -1 led to invalid memory reads. + values to identify the argument indices of the various script + arguments to [try]. Passing in -1 led to invalid memory reads. 2010-03-20 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 6c311f9b..e63e07c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -10,12 +10,12 @@ * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. - * Copyright (c) 2003 Donal K. Fellows. + * Copyright (c) 2003-2009 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.208 2010/03/23 23:25:55 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.209 2010/03/24 10:25:59 dkf Exp $ */ #include "tclInt.h" @@ -4363,17 +4363,31 @@ TryPostBody( cmdObj = objv[0]; /* + * Check for limits/rewinding, which override normal trapping behaviour. + */ + + if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"%s\" body line %d)", TclGetString(cmdObj), + Tcl_GetErrorLine(interp))); + if (handlersObj != NULL) { + Tcl_DecrRefCount(handlersObj); + } + return TCL_ERROR; + } + + /* * Basic processing of the outcome of the script, including adding of * errorinfo trace. */ - resultObj = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resultObj); if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%s\" body line %d)", TclGetString(cmdObj), Tcl_GetErrorLine(interp))); } + resultObj = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(resultObj); options = Tcl_GetReturnOptions(interp, result); Tcl_IncrRefCount(options); Tcl_ResetResult(interp); @@ -4554,7 +4568,6 @@ TryPostHandler( Tcl_Obj *finallyObj; int finally; - objv = data[0]; options = data[1]; handlerKindObj = data[2]; @@ -4564,6 +4577,19 @@ TryPostHandler( finallyObj = finally ? objv[finally] : 0; /* + * Check for limits/rewinding, which override normal trapping behaviour. + */ + + if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) { + options = During(interp, result, options, Tcl_ObjPrintf( + "\n (\"%s ... %s\" handler line %d)", + TclGetString(cmdObj), TclGetString(handlerKindObj), + Tcl_GetErrorLine(interp))); + Tcl_DecrRefCount(options); + return TCL_ERROR; + } + + /* * The handler result completely substitutes for the result of the body. */ |