From 653f52ba6008466571d283d523272ae22c2cf2c4 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 9 Aug 2011 17:01:16 +0000 Subject: [Bug 3386417] avoid a reference loop between the bytecode and its companion errostack when compiling a syntax error. --- ChangeLog | 6 ++++++ generic/tclCompCmds.c | 2 +- generic/tclInt.h | 1 + generic/tclResult.c | 23 +++++++++++++++++++++++ 4 files changed, 31 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index c2cf484..04d506b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2011-08-09 Alexandre Ferrieux + + * generic/tclCompCmds.c: [Bug 3386417] avoid a reference loop between + * generic/tclInt.h: the bytecode and its companion errostack + * generic/tclResult.c: when compiling a syntax error. + 2011-08-09 Jan Nijtmans * win/tclWinConsole.c: [Bug 3388350] mingw64 compiler warnings diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 083f530..66c03ab 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3644,7 +3644,7 @@ TclCompileSyntaxError( TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, - Tcl_GetReturnOptions(interp, TCL_ERROR)); + TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index e4a7782..9f00077 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3016,6 +3016,7 @@ MODULE_SCOPE int TclMaxListLength(const char *bytes, int numBytes, MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, diff --git a/generic/tclResult.c b/generic/tclResult.c index 60bae73..4443cc1 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1599,6 +1599,29 @@ Tcl_GetReturnOptions( /* *------------------------------------------------------------------------- * + * TclNoErrorStack -- + * + * Removes the -errorstack entry from an options dict to avoid reference cycles + * + * Results: + * The (unshared) argument options dict, modified in -place. + * + *------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options) +{ + Tcl_Obj **keys = GetKeys(); + + Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]); + + return options; +} + +/* + *------------------------------------------------------------------------- + * * Tcl_SetReturnOptions -- * * Accepts an interp and a dictionary of return options, and sets the -- cgit v0.12