diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompCmds.c | 2 | ||||
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | generic/tclResult.c | 23 |
3 files changed, 25 insertions, 1 deletions
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 |