summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclStubLib.c52
-rw-r--r--generic/tclStubLibCompat.c57
-rw-r--r--unix/Makefile.in6
-rw-r--r--win/Makefile.in4
-rw-r--r--win/makefile.vc4
6 files changed, 115 insertions, 10 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1d04c82..ae76e73 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3859,6 +3859,8 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE const char *TclInitStubs(Tcl_Interp *interp, const char *version,
+ int exact, const char *tclversion, int magic);
/*
* Functions defined in generic/tclVar.c and currenttly exported only for use
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 0efaf50..96f7f2f 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -34,11 +34,12 @@ const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
static const TclStubs *
HasStubSupport(
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int magic)
{
Interp *iPtr = (Interp *) interp;
-
- if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
+ if (iPtr->stubTable && iPtr->stubTable->magic == magic
+ && iPtr->stubTable->magic == TCL_STUB_MAGIC) {
return iPtr->stubTable;
}
iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
@@ -58,7 +59,7 @@ static int isDigit(const int c)
/*
*----------------------------------------------------------------------
*
- * Tcl_InitStubs --
+ * TclInitStubs --
*
* Tries to initialise the stub table pointers and ensures that the
* correct version of Tcl is loaded.
@@ -74,13 +75,19 @@ static int isDigit(const int c)
*/
MODULE_SCOPE const char *
-Tcl_InitStubs(
+TclInitStubs(
Tcl_Interp *interp,
const char *version,
- int exact)
+ int exact,
+ const char *tclversion,
+ int magic)
{
+ const char *p;
+ char *q;
+ char major[TCL_INTEGER_SPACE];
const char *actualVersion = NULL;
ClientData pkgData = NULL;
+ Interp *iPtr = (Interp *) interp;
/*
* We can't optimize this check by caching tclStubsPtr because that
@@ -88,24 +95,51 @@ Tcl_InitStubs(
* times. [Bug 615304]
*/
- tclStubsPtr = HasStubSupport(interp);
+ tclStubsPtr = HasStubSupport(interp, magic);
if (!tclStubsPtr) {
return NULL;
}
+ /*
+ * Check that the [load]ing interp and [load]ed extension were compiled
+ * against headers from the same major version of Tcl. If not, they
+ * will not agree on the layout of the stubs and will crash. Report
+ * the error instead of crashing.
+ */
+
+ p = tclversion;
+ q = major;
+ while (isDigit(*p)) {
+ *q++ = *p++;
+ if (q-major > TCL_INTEGER_SPACE) {
+ iPtr->result = (char *) "major version overflow";
+ iPtr->freeProc = TCL_STATIC;
+ return NULL;
+ }
+ }
+ *q = '\0';
+
+ if (NULL == Tcl_PkgRequireEx(interp, "Tcl", major, 0, NULL)) {
+ return NULL;
+ }
+
+ /*
+ * Check satisfaction of the requirement requested by the caller.
+ */
+
actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
if (actualVersion == NULL) {
return NULL;
}
if (exact) {
- const char *p = version;
int count = 0;
+ p = version;
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
new file mode 100644
index 0000000..dfb2e5f
--- /dev/null
+++ b/generic/tclStubLibCompat.c
@@ -0,0 +1,57 @@
+/*
+ * 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 TCL_VERSION and Tcl8 magic value here. */
+ return TclInitStubs(interp, version, exact, "8.6", (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 df05759..0b99eac 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -335,7 +335,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
-STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
+STUB_LIB_OBJS = tclStubLib.o tclStubLibCompat.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
@@ -468,6 +468,7 @@ OO_SRCS = \
STUB_SRCS = \
$(GENERIC_DIR)/tclStubLib.c \
+ $(GENERIC_DIR)/tclStubCompat.c \
$(GENERIC_DIR)/tclTomMathStubLib.c \
$(GENERIC_DIR)/tclOOStubLib.c
@@ -1656,6 +1657,9 @@ 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 8cfb68c..78c5bb1 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -378,6 +378,7 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
+ tclStubLibCompat.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
tclOOStubLib.$(OBJEXT)
@@ -508,6 +509,9 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
diff --git a/win/makefile.vc b/win/makefile.vc
index 2784140..c35af6b 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -448,6 +448,7 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclStubLibCompat.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
$(TMP_DIR)\tclOOStubLib.obj
@@ -977,6 +978,9 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+$(TMP_DIR)\tclStubLibCompat.obj: $(GENERICDIR)\tclStubLibCompat.c
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
generated by cgit v0.12 at 2025-06-01 10:03:19 (GMT)