summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclCompCmdsSZ.c14
-rw-r--r--generic/tclStubLib.c32
-rw-r--r--generic/tclZlib.c52
4 files changed, 59 insertions, 43 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 74dd452..049499c 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2395,7 +2395,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
*/
const char * TclInitStubs(Tcl_Interp *interp, const char *version,
- int exact, int major);
+ int exact, int major, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
@@ -2405,7 +2405,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
#ifdef USE_TCL_STUBS
#define Tcl_InitStubs(interp, version, exact) \
- TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION)
+ 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/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index be63e0e..9c93fb2 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1224,12 +1224,7 @@ TclCompileSwitchCmd(
if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
&(bodyTokenArray[numWords].start), &bytes,
&(bodyTokenArray[numWords].size), &literal) || !literal) {
- abort:
- ckfree((char *) bodyToken);
- ckfree((char *) bodyTokenArray);
- ckfree((char *) bodyLines);
- ckfree((char *) bodyContLines);
- return TCL_ERROR;
+ goto abort;
}
bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
@@ -1254,7 +1249,12 @@ TclCompileSwitchCmd(
numWords++;
}
if (numWords % 2) {
- goto abort;
+ abort:
+ ckfree((char *) bodyToken);
+ ckfree((char *) bodyTokenArray);
+ ckfree((char *) bodyLines);
+ ckfree((char *) bodyContLines);
+ return TCL_ERROR;
}
} else if (numWords % 2 || numWords == 0) {
/*
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index ca6f4ff..12652a5 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -41,9 +41,7 @@ HasStubSupport(
if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
return iPtr->stubTable;
}
-
- iPtr->result =
- (char *)"This interpreter does not support stubs-enabled extensions.";
+ iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -80,7 +78,8 @@ TclInitStubs(
Tcl_Interp *interp,
const char *version,
int exact,
- int major)
+ int major,
+ int magic)
{
Interp *iPtr = (Interp *) interp;
const char *actualVersion = NULL;
@@ -89,13 +88,16 @@ TclInitStubs(
/*
* Detect whether the extension and the stubs library were built
- * against Tcl header files from different major versions. That's
- * seriously broken.
+ * 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 (major != TCL_MAJOR_VERSION) {
+ if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) {
iPtr->result =
- (char *)"extension linked to incompatible stubs library";
+ (char *) "extension linked to incompatible stubs library";
iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -118,7 +120,7 @@ TclInitStubs(
if (isDigit(*q)) {
badVersion:
iPtr->result =
- (char *)"extension passed bad version argument to stubs library";
+ (char *) "extension passed bad version argument to stubs library";
iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -179,6 +181,16 @@ TclInitStubs(
return actualVersion;
}
+/*
+ * This routine is included only so that extensions compiled against
+ * 8.5 and earlier headers (which do not define Tcl_InitStubs() as a macro)
+ * can successfully link to libtclstubs8.6.a. This leaves them suffering
+ * from the formerly broken design. (See Tcl Bug 3588687).
+ *
+ * This routine should not merge forward to Tcl 9 work. Extensions
+ * compiled against 8.5 and earlier headers that try to link to
+ * libtclstubs9*.a should suffer the link failure.
+ */
#undef Tcl_InitStubs
MODULE_SCOPE const char *
Tcl_InitStubs(
@@ -186,7 +198,7 @@ Tcl_InitStubs(
const char *version,
int exact)
{
- return TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION);
+ return TclInitStubs(interp, version, exact, 8, TCL_STUB_MAGIC);
}
/*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 11490f1..8fbe049 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2177,29 +2177,36 @@ ZlibStreamSubcmd(
FMT_INFLATE
};
int i, format, mode = 0, option, level;
+ enum objIndices {
+ OPT_COMPRESSION_DICTIONARY = 0,
+ OPT_GZIP_HEADER = 1,
+ OPT_COMPRESSION_LEVEL = 2,
+ OPT_END = -1
+ };
+ Tcl_Obj *obj[3] = { NULL, NULL, NULL };
+#define compDictObj obj[OPT_COMPRESSION_DICTIONARY]
+#define gzipHeaderObj obj[OPT_GZIP_HEADER]
+#define levelObj obj[OPT_COMPRESSION_LEVEL]
typedef struct {
const char *name;
- Tcl_Obj **valueVar;
+ enum objIndices offset;
} OptDescriptor;
- Tcl_Obj *compDictObj = NULL;
- Tcl_Obj *gzipHeaderObj = NULL;
- Tcl_Obj *levelObj = NULL;
- const OptDescriptor compressionOpts[] = {
- { "-dictionary", &compDictObj },
- { "-level", &levelObj },
- { NULL, NULL }
+ static const OptDescriptor compressionOpts[] = {
+ { "-dictionary", OPT_COMPRESSION_DICTIONARY },
+ { "-level", OPT_COMPRESSION_LEVEL },
+ { NULL, OPT_END }
};
- const OptDescriptor gzipOpts[] = {
- { "-header", &gzipHeaderObj },
- { "-level", &levelObj },
- { NULL, NULL }
+ static const OptDescriptor gzipOpts[] = {
+ { "-header", OPT_GZIP_HEADER },
+ { "-level", OPT_COMPRESSION_LEVEL },
+ { NULL, OPT_END }
};
- const OptDescriptor expansionOpts[] = {
- { "-dictionary", &compDictObj },
- { NULL, NULL }
+ static const OptDescriptor expansionOpts[] = {
+ { "-dictionary", OPT_COMPRESSION_DICTIONARY },
+ { NULL, OPT_END }
};
- const OptDescriptor gunzipOpts[] = {
- { NULL, NULL }
+ static const OptDescriptor gunzipOpts[] = {
+ { NULL, OPT_END }
};
const OptDescriptor *desc = NULL;
Tcl_ZlibStream zh;
@@ -2262,13 +2269,7 @@ ZlibStreamSubcmd(
sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
return TCL_ERROR;
}
- *desc[option].valueVar = objv[i+1];
-
- /*
- * Drop the cache on the option name; table address not constant.
- */
-
- TclFreeIntRep(objv[i]);
+ obj[desc[option].offset] = objv[i+1];
}
/*
@@ -2300,6 +2301,9 @@ ZlibStreamSubcmd(
}
Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
return TCL_OK;
+#undef compDictObj
+#undef gzipHeaderObj
+#undef levelObj
}
/*
generated by cgit v0.12 at 2024-08-21 05:20:50 (GMT)