Proposed fix for [fc35093ce]: Better error-message than "interpreter …

…uses an incompatible stubs mechanism"
tcltk · Jan 3, 2025 · 8648d41 · 8648d41
1 parent ed91fb4
commit 8648d41
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 10 deletions.
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
@@ -482,11 +482,10 @@ Tcl_LoadObjCmd(
 	Interp *iPtr = (Interp *) target;
 	if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
 	    /*
-	     * A call to Tcl_InitStubs() determined the caller extension and
-	     * this interp are incompatible in their stubs mechanisms, and
-	     * recorded the error in the oldest legacy place we have to do so.
+	     * A call to Tcl_InitStubs() determined the caller extension
+	     * Stubs were introduced in Tcl 8.1, so there's only one possible reason.
 	     */
-	    Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
+	    Tcl_SetObjResult(target, Tcl_NewStringObj("this extension is compiled for Tcl 8.x", -1));
 	    iPtr->legacyResult = NULL;
 	    iPtr->legacyFreeProc = (void (*) (void))-1;
 	}

diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
@@ -60,19 +60,26 @@ Tcl_InitStubs(
     const char *actualVersion = NULL;
     void *pkgData = NULL;
     const TclStubs *stubsPtr = iPtr->stubTable;
-    const char *tclName = (((exact&0xFF00) >= 0x900) ? "tcl" : "Tcl");
+    const char *tclName = "tcl";
 
-#undef TCL_STUB_MAGIC /* We need the TCL_STUB_MAGIC from Tcl 8.x here */
-#define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
+    if ((exact&0xFF00) < 0x900) {
+	magic = (int) 0xFCA3BACF; /* TCL_STUB_MAGIC from Tcl 8.x */
+	tclName = "Tcl";
+    }
     /*
      * We can't optimize this check by caching tclStubsPtr because that
      * prevents apps from being able to load/unload Tcl dynamically multiple
      * times. [Bug 615304]
      */
 
-    if (!stubsPtr || (stubsPtr->magic != (((exact&0xFF00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
-	iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
-	iPtr->legacyFreeProc = 0; /* TCL_STATIC */
+    if (!stubsPtr || (stubsPtr->magic != magic)) {
+	if (((exact&0xFF00) >= 0x900) && stubsPtr && (stubsPtr->magic == TCL_STUB_MAGIC)) {
+	    stubsPtr->tcl_SetObjResult(interp, stubsPtr->tcl_ObjPrintf("this extension is compiled for Tcl %d.%d",
+		    (exact&0xFF00)>>8, (exact&0xFF0000)>>16));
+	} else {
+	    iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
+	    iPtr->legacyFreeProc = 0; /* TCL_STATIC */
+	}
 	return NULL;
     }