Proposed rollback of the TCL_STUB_MAGIC change on novem branch.novem_review

8 files changed, 56 insertions, 118 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index b9ff28c..91bf623 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -136,7 +136,6 @@ extern "C" {
  */
 
 #include <stdio.h>
-#include <stddef.h>
 
 /*
  *----------------------------------------------------------------------------
@@ -2276,7 +2275,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
  * stubs tables.
  */
 
-#define TCL_STUB_MAGIC		((int) (0xFCA3BACB + sizeof(size_t)))
+#define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
 
 /*
  * The following function is required to be defined in all stubs aware
@@ -2286,7 +2285,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
  */
 
 const char *		TclInitStubs(Tcl_Interp *interp, const char *version,
-			    int exact, int magic);
+			    int exact, int major, int magic);
 const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 			    const char *version, int epoch, int revision);
 
@@ -2296,7 +2295,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 
 #ifdef USE_TCL_STUBS
 #define Tcl_InitStubs(interp, version, exact) \
-    TclInitStubs(interp, version, exact, TCL_STUB_MAGIC)
+    TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION, TCL_STUB_MAGIC)
 #else
 #define Tcl_InitStubs(interp, version, exact) \
     Tcl_PkgInitStubsCheck(interp, version, exact)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 146247e..4f3b77e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -431,14 +431,6 @@ TclFinalizeEvaluation(void)
  *----------------------------------------------------------------------
  */
 
-/* Template for internal Interp structure: the stubTable entry cannot move! */
-typedef struct {
-    char *dumm1;
-    Tcl_FreeProc *dummy2;
-    int dummy3;
-    const struct TclStubs *stubTable;
-} InterpTemplate;
-
 Tcl_Interp *
 Tcl_CreateInterp(void)
 {
@@ -474,21 +466,6 @@ Tcl_CreateInterp(void)
 	/*NOTREACHED*/
 	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
     }
-    if ((void *) tclStubs.tcl_SetObjResult
-		    != (void *)((&(tclStubs.tcl_PkgProvideEx))[235])) {
-	/*NOTREACHED*/
-	Tcl_Panic("Tcl_SetObjResult entry in the stub table must be kept");
-    }
-    if ((void *) tclStubs.tcl_NewStringObj
-		    != (void *)((&(tclStubs.tcl_PkgProvideEx))[56])) {
-	/*NOTREACHED*/
-	Tcl_Panic("Tcl_NewStringObj entry in the stub table must be kept");
-    }
-    if (TclOffset(InterpTemplate, stubTable)
-		    != TclOffset(Interp, stubTable)) {
-	/*NOTREACHED*/
-	Tcl_Panic("stubsTable entry in the Interp structure must be kept");
-    }
 
     if (cancelTableInitialized == 0) {
 	Tcl_MutexLock(&cancelLock);
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 61c763f..6f5b9cf 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -474,9 +474,8 @@ Tcl_LoadObjCmd(
 	    /* We have an Tcl 8.x extension with incompatible stub table. */
 	    Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1);
 	    Tcl_SetObjResult(interp, obj);
-	} else {
-	    Tcl_TransferResult(target, code, interp);
 	}
+	Tcl_TransferResult(target, code, interp);
 	goto done;
     }
 
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index bd80ec1..f1229d5 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -34,29 +34,17 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
 
 static const TclStubs *
 HasStubSupport(
-    Tcl_Interp *interp,
-    int magic)
+    Tcl_Interp *interp)
 {
     Interp *iPtr = (Interp *) interp;
 
-    if (!iPtr->stubTable) {
-	/* No stub table at all? Nothing we can do. */
-	return NULL;
-    }
-    if (iPtr->stubTable->magic != magic) {
-	/*
-	 * The iPtr->stubTable entry from Tcl_Interp and the
-	 * Tcl_NewStringObj() and Tcl_SetObjResult() entries
-	 * in the stub table cannot change in Tcl 9 compared
-	 * to Tcl 8.x. Otherwise the lines below won't work.
-	 * TODO: add a test case for that.
-	 */
-	iPtr->stubTable->tcl_SetObjResult(interp,
-		iPtr->stubTable->tcl_NewStringObj(
-			"This extension is compiled for Tcl 9.x", -1));
-	return NULL;
+    if (iPtr->stubTable && iPtr->stubTable->magic == TCL_STUB_MAGIC) {
+	return iPtr->stubTable;
     }
-    return iPtr->stubTable;
+    iPtr->result =
+	    (char *) "interpreter uses an incompatible stubs mechanism";
+    iPtr->freeProc = TCL_STATIC;
+    return NULL;
 }
 
 /*
@@ -91,10 +79,52 @@ TclInitStubs(
     Tcl_Interp *interp,
     const char *version,
     int exact,
+    int major,
     int magic)
 {
+    Interp *iPtr = (Interp *) interp;
     const char *actualVersion = NULL;
     ClientData pkgData = NULL;
+    const char *p, *q;
+
+    /*
+     * Detect whether the extension and the stubs library were built
+     * against Tcl header files declaring use of incompatible stubs
+     * mechanisms.  Even within the same mechanism, also detect if
+     * the header files are from different major versions.  Either
+     * is seriously broken.  An extension and its stubs library ought
+     * to share compatible headers, if not the same one.
+     */
+
+    if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) {
+	iPtr->result =
+		(char *) "extension linked to incompatible stubs library";
+	iPtr->freeProc = TCL_STATIC;
+	return NULL;
+    }
+
+    /*
+     * Detect whether an extension compiled against a Tcl header file
+     * of one major version is requesting to use a stubs table of a
+     * different major version.  According to our compat rules, that's
+     * a request that cannot succeed.  Different major versions imply
+     * incompatible stub tables.
+     */
+
+    p = version;
+    q = TCL_VERSION;
+    while (isDigit(*p)) {
+	if (*p++ != *q++) {
+	    goto badVersion;
+	}
+    }
+    if (isDigit(*q)) {
+    badVersion:
+	iPtr->result = (char *)
+		"extension passed bad version argument to stubs library";
+	iPtr->freeProc = TCL_STATIC;
+	return NULL;
+    }
 
     /*
      * We can't optimize this check by caching tclStubsPtr because that
@@ -102,7 +132,7 @@ TclInitStubs(
      * times. [Bug 615304]
      */
 
-    tclStubsPtr = HasStubSupport(interp, magic);
+    tclStubsPtr = HasStubSupport(interp);
     if (!tclStubsPtr) {
 	return NULL;
     }
@@ -112,14 +142,14 @@ TclInitStubs(
 	return NULL;
     }
     if (exact) {
-	const char *p = version;
+	p = version;
 	int count = 0;
 
 	while (*p) {
 	    count += !isDigit(*p++);
 	}
 	if (count == 1) {
-	    const char *q = actualVersion;
+	    q = actualVersion;
 
 	    p = version;
 	    while (*p && (*p == *q)) {
diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c
deleted file mode 100644
index 7d8c5c3..0000000
--- a/generic/tclStubLibCompat.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * tclStubLibCompat.c --
- *
- *	Stub object that will be statically linked into extensions that want
- *	to access Tcl.
- *
- * Copyright (c) 2012 Jan Nijtmans
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-/*
- * Small wrapper, which allows Tcl8 extensions to use the same stub
- * library as Tcl 9.
- */
-
-#include "tclInt.h"
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitStubs --
- *
- *	Tries to initialise the stub table pointers and ensures that the
- *	correct version of Tcl is loaded.
- *
- * Results:
- *	The actual version of Tcl that satisfies the request, or NULL to
- *	indicate that an error occurred.
- *
- * Side effects:
- *	Sets the stub table pointers.
- *
- *----------------------------------------------------------------------
- */
-#undef Tcl_InitStubs
-
-MODULE_SCOPE const char *
-Tcl_InitStubs(
-    Tcl_Interp *interp,
-    const char *version,
-    int exact)
-{
-    /* Use the hardcoded Tcl8 magic value here. */
-    return TclInitStubs(interp, version, exact, (int) 0xFCA3BACF);
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
-
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 9a7d6db..b89b2e6 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -336,7 +336,6 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
         bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
 
 STUB_LIB_OBJS = tclStubLib.o \
-	tclStubLibCompat.o \
 	tclTomMathStubLib.o \
 	tclOOStubLib.o \
 	${COMPAT_OBJS}
@@ -472,7 +471,6 @@ OO_SRCS = \
 
 STUB_SRCS = \
 	$(GENERIC_DIR)/tclStubLib.c \
-	$(GENERIC_DIR)/tclStubLibCompat.c \
 	$(GENERIC_DIR)/tclTomMathStubLib.c \
 	$(GENERIC_DIR)/tclOOStubLib.c
 
@@ -1661,9 +1659,6 @@ Zzutil.o:    $(ZLIB_DIR)/zutil.c
 tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
 	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c
 
-tclStubLibCompat.o: $(GENERIC_DIR)/tclStubLibCompat.c
-	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibCompat.c
-
 tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
 	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index 6b9685d..dacbbb5 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -378,7 +378,6 @@ REG_OBJS = tclWinReg.$(OBJEXT)
 
 STUB_OBJS = \
 	tclStubLib.$(OBJEXT) \
-	tclStubLibCompat.$(OBJEXT) \
 	tclTomMathStubLib.$(OBJEXT) \
 	tclOOStubLib.$(OBJEXT)
 
@@ -506,9 +505,6 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
 # The following objects are part of the stub library and should not be built
 # as DLL objects but none of the symbols should be exported
 
-tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c
-	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
-
 tclStubLib.${OBJEXT}: tclStubLib.c
 	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
 
diff --git a/win/makefile.vc b/win/makefile.vc
index 823142f..2784140 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -448,7 +448,6 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
 
 TCLSTUBOBJS = \
 	$(TMP_DIR)\tclStubLib.obj \
-	$(TMP_DIR)\tclStubLibCompat.obj \
 	$(TMP_DIR)\tclTomMathStubLib.obj \
 	$(TMP_DIR)\tclOOStubLib.obj