From e3bbe59fa932fe500376ca9592114bc997d2162f Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Wed, 22 Sep 2010 15:49:01 +0000 Subject: * generic/tclExecute: protect all possible writes to ::errorInfo or ::errorCode with DECACHE_STACK_INFO(), as they could run traces. The new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(), IllegalExprOperandType(), TclExprFloatError(). The error was triggered by [Patch 3072080]. --- ChangeLog | 8 ++++++++ generic/tclExecute.c | 46 ++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 52 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7992892..29c20f3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2010-09-22 Miguel Sofer + + * generic/tclExecute: protect all possible writes to ::errorInfo + or ::errorCode with DECACHE_STACK_INFO(), as they could run + traces. The new calls to be protected are Tcl_ResetResult(), + Tcl_SetErrorCode(), IllegalExprOperandType(), + TclExprFloatError(). The error was triggered by [Patch 3072080]. + 2010-09-22 Jan Nijtmans * win/tcl.m4: Add kernel32 to LIBS, so the link line for mingw diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 71999d2..c7a8e20 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.495 2010/09/22 00:57:11 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.496 2010/09/22 15:49:01 msofer Exp $ */ #include "tclInt.h" @@ -2858,23 +2858,27 @@ TclExecuteByteCode( Tcl_SetResult(interp, "yield can only be called in a coroutine", TCL_STATIC); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); + CACHE_STACK_INFO(); pc--; goto gotError; } NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); NRE_ASSERT(corPtr->stackLevel != NULL); - NRE_ASSERT(BP == corPtr->eePtr->bottomPtr); if (corPtr->stackLevel != &TAUX) { Tcl_SetResult(interp, "cannot yield: C stack busy", TCL_STATIC); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL); + CACHE_STACK_INFO(); pc--; goto gotError; } + NRE_ASSERT(BP == corPtr->eePtr->bottomPtr); /* * Mark suspended, save our state and return @@ -4146,14 +4150,18 @@ TclExecuteByteCode( if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto gotError; } @@ -4956,7 +4964,9 @@ TclExecuteByteCode( TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } @@ -4965,7 +4975,9 @@ TclExecuteByteCode( TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto gotError; } @@ -5023,9 +5035,11 @@ TclExecuteByteCode( Tcl_SetResult(interp, "negative shift argument", TCL_STATIC); #if 0 + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); + CACHE_STACK_INFO(); #endif goto gotError; } else if (l1 == 0) { @@ -5069,9 +5083,11 @@ TclExecuteByteCode( Tcl_SetResult(interp, "negative shift argument", TCL_STATIC); #if 0 + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); + CACHE_STACK_INFO(); #endif goto gotError; } else if (l1 == 0) { @@ -5091,8 +5107,10 @@ TclExecuteByteCode( "integer value too large to represent", TCL_STATIC); #if 0 + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", NULL); + CACHE_STACK_INFO(); #endif goto gotError; } else { @@ -5175,7 +5193,9 @@ TclExecuteByteCode( TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name: "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } @@ -5194,7 +5214,9 @@ TclExecuteByteCode( TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (value2Ptr->typePtr? value2Ptr->typePtr->name: "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); + CACHE_STACK_INFO(); goto gotError; } @@ -5341,7 +5363,9 @@ TclExecuteByteCode( if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } /* TODO: Consider peephole opt. */ @@ -5359,7 +5383,9 @@ TclExecuteByteCode( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } if (type1 == TCL_NUMBER_LONG) { @@ -5384,7 +5410,9 @@ TclExecuteByteCode( || IsErroringNaNType(type1)) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } switch (type1) { @@ -5428,7 +5456,9 @@ TclExecuteByteCode( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); goto gotError; } @@ -5444,7 +5474,9 @@ TclExecuteByteCode( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); + DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); + CACHE_STACK_INFO(); } else { /* * Numeric conversion of NaN -> error. @@ -5452,7 +5484,9 @@ TclExecuteByteCode( TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", O2S(objResultPtr))); + DECACHE_STACK_INFO(); TclExprFloatError(interp, *((const double *) ptr1)); + CACHE_STACK_INFO(); } goto gotError; } @@ -5692,7 +5726,9 @@ TclExecuteByteCode( case INST_END_CATCH: catchTop--; + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); + CACHE_STACK_INFO(); TRESULT = TCL_OK; TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); @@ -5768,11 +5804,13 @@ TclExecuteByteCode( TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } + DECACHE_STACK_INFO(); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS), "\" not known in dictionary", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), NULL); + CACHE_STACK_INFO(); TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp)); } else { TRACE_WITH_OBJ(( @@ -6337,8 +6375,10 @@ TclExecuteByteCode( */ divideByZero: + DECACHE_STACK_INFO(); Tcl_SetResult(interp, "divide by zero", TCL_STATIC); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); + CACHE_STACK_INFO(); goto gotError; /* @@ -6347,10 +6387,12 @@ TclExecuteByteCode( */ exponOfZero: + DECACHE_STACK_INFO(); Tcl_SetResult(interp, "exponentiation of zero by negative power", TCL_STATIC); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); + CACHE_STACK_INFO(); /* * Almost all error paths feed through here rather than assigning to -- cgit v0.12