summaryrefslogtreecommitdiffstats
path: root/generic/tclMain.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r--generic/tclMain.c87
1 files changed, 72 insertions, 15 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 26383b5..c7166d7 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -125,6 +125,7 @@ typedef struct InteractiveState {
MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
static void StdinProc(ClientData clientData, int mask);
+static void FreeMainInterp(ClientData clientData);
#ifndef TCL_ASCII_MAIN
static Tcl_ThreadDataKey dataKey;
@@ -387,6 +388,13 @@ Tcl_MainEx(
if (Tcl_LimitExceeded(interp)) {
goto done;
}
+ if (TclFullFinalizationRequested()) {
+ /*
+ * Arrange for final deletion of the main interp
+ */
+ // ARGH Munchhausen effect
+ Tcl_CreateExitHandler(FreeMainInterp, (ClientData)interp);
+ }
/*
* Invoke the script specified on the command line, if any. Must fetch it
@@ -597,31 +605,18 @@ Tcl_MainEx(
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
-
+
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
}
-
+ }
/*
* If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
* is happening. Maybe interp has been deleted; maybe [exit] was
* redefined, maybe we've blown up because of an exceeded limit. We
* still want to cleanup and exit.
*/
-
- if (!Tcl_InterpDeleted(interp)) {
- Tcl_DeleteInterp(interp);
- }
- }
- Tcl_SetStartupScript(NULL, NULL);
-
- /*
- * If we get here, the master interp has been deleted. Allow its
- * destruction with the last matching Tcl_Release.
- */
-
- Tcl_Release(interp);
Tcl_Exit(exitCode);
}
@@ -699,6 +694,42 @@ TclGetMainLoop(void)
/*
*----------------------------------------------------------------------
*
+ * TclFullFinalizationRequested --
+ *
+ * This function returns true when either -DPURIFY is specified, or the
+ * environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This
+ * predicate is called at places affecting the exit sequence, so that the
+ * default behavior is a fast and deadlock-free exit, and the modified
+ * behavior is a more thorough finalization for debugging purposes (leak
+ * hunting etc).
+ *
+ * Results:
+ * A boolean.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE int
+TclFullFinalizationRequested(void)
+{
+#ifdef PURIFY
+ return 1;
+#else
+ const char *fin;
+ Tcl_DString ds;
+ int finalize = 0;
+
+ fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
+ finalize = ((fin != NULL) && strcmp(fin, "0"));
+ if (fin != NULL) {
+ Tcl_DStringFree(&ds);
+ }
+ return finalize;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* StdinProc --
*
* This function is invoked by the event dispatcher whenever standard
@@ -881,6 +912,32 @@ Prompt(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMainInterp --
+ *
+ * Exit handler used to cleanup the main interpreter and ancillary startup
+ * script storage at exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMainInterp(
+ ClientData clientData)
+{
+ Tcl_Interp *interp = (Tcl_Interp *) clientData;
+
+ //if (TclInExit()) return;
+
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_DeleteInterp(interp);
+ }
+ Tcl_SetStartupScript(NULL, NULL);
+ Tcl_Release(interp);
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4