Initialize legacyFreeProc with invalid value: This will result in

a crash immediately, when an extention tries to call it, in stead
of crashing some time later....
Remove some more legacy regarding accessing interp->result

5 files changed, 10 insertions, 28 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 24a1082..7202184 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -486,7 +486,11 @@ Tcl_CreateInterp(void)
     interp = (Tcl_Interp *) iPtr;
 
     iPtr->legacyResult = NULL;
+    /* Special invalid value: Any attempt to free the legacy result
+     * will cause a crash. */
+    iPtr->legacyFreeProc = (void (*) (void))-1;
     iPtr->errorLine = 0;
+    iPtr->stubTable = &tclStubs;
     iPtr->objResultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(iPtr->objResultPtr);
     iPtr->handle = TclHandleCreate(iPtr);
@@ -681,12 +685,6 @@ Tcl_CreateInterp(void)
 #endif /* TCL_COMPILE_STATS */
 
     /*
-     * Initialise the stub table pointer.
-     */
-
-    iPtr->stubTable = &tclStubs;
-
-    /*
      * Initialize the ensemble error message rewriting support.
      */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5192688..0efb1b6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1811,8 +1811,8 @@ typedef struct Interp {
      * that one undisturbed.
      */
 
-    char *legacyResult;
-    Tcl_FreeProc *legacyFreeProc;
+    const char *legacyResult;
+    void (*legacyFreeProc) (void);
     int errorLine;		/* When TCL_ERROR is returned, this gives the
 				 * line number in the command where the error
 				 * occurred (1 means first line). */
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 80efdd8..75e513d 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -470,7 +470,7 @@ Tcl_LoadObjCmd(
 
     if (code != TCL_OK) {
 	Interp *iPtr = (Interp *) target;
-	if (iPtr->legacyResult != NULL) {
+	if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
 	    /*
 	     * A call to Tcl_InitStubs() determined the caller extension and
 	     * this interp are incompatible in their stubs mechanisms, and
@@ -478,6 +478,7 @@ Tcl_LoadObjCmd(
 	     */
 	    Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
 	    iPtr->legacyResult = NULL;
+	    iPtr->legacyFreeProc = (void (*) (void))-1;
 	}
 	Tcl_TransferResult(target, code, interp);
 	goto done;
diff --git a/generic/tclResult.c b/generic/tclResult.c
index b8f9c92..618b7d8 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -474,23 +474,6 @@ Tcl_AppendResultVA(
     }
     Tcl_AppendStringsToObjVA(objPtr, argList);
     Tcl_SetObjResult(interp, objPtr);
-
-    /*
-     * Strictly we should call Tcl_GetStringResult(interp) here to make sure
-     * that interp->result is correct according to the old contract, but that
-     * makes the performance of much code (e.g. in Tk) absolutely awful. So we
-     * leave it out; code that really wants interp->result can just insert the
-     * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
-     */
-
-#ifdef USE_INTERP_RESULT
-    /*
-     * Ensure that the interp->result is legal so old Tcl 7.* code still
-     * works. There's still embarrasingly much of it about...
-     */
-
-    (void) Tcl_GetStringResult(interp);
-#endif /* USE_INTERP_RESULT */
 }
 
 /*
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 501072c..9a2e063 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -47,8 +47,8 @@ HasStubSupport(
 	return iPtr->stubTable;
     }
     iPtr->legacyResult
-	    = (char *) "interpreter uses an incompatible stubs mechanism";
-    iPtr->legacyFreeProc = TCL_STATIC;
+	    = "interpreter uses an incompatible stubs mechanism";
+    iPtr->legacyFreeProc = 0; /* TCL_STATIC */
     return NULL;
 }