[Bug 3386417] avoid a reference loop between the bytecode and its companion errostack when compiling a syntax error.

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