summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-11-18 17:04:38 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-11-18 17:04:38 (GMT)
commit3a030386112001a10caf4c697a743b7f2796c9ab (patch)
tree95f166e0f103c5a9deafed1f4712c76710211326
parent10dd9595a33e80ac7ab8ae5ff11b6b6ef3059b20 (diff)
parent592d64c6569bf3d85d3797d35a18183d7ff9d098 (diff)
downloadtcl-on_hold_85.zip
tcl-on_hold_85.tar.gz
tcl-on_hold_85.tar.bz2
<i>On hold at Don Porter's request</i> on_hold_85
hange stub library to detect - and generate a nice error-message - when a shared library compiled for Tcl 8.x is attempted to be loaded in Tcl 9.x: Tcl 9 will not have the iPtr->result field so we cannot use that any more.
-rw-r--r--generic/tclStubLib.c33
1 files changed, 26 insertions, 7 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 1f5b436..14adbc8 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -35,20 +35,39 @@ TclIntStubs *tclIntStubsPtr = NULL;
TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclTomMathStubs* tclTomMathStubsPtr = NULL;
+typedef Tcl_Obj *(NewStringObjProc) (CONST char *bytes, size_t length);
+
+
static TclStubs *
HasStubSupport(
Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
- if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
- return iPtr->stubTable;
+ if (!iPtr->stubTable) {
+ /* No stub table at all? Nothing we can do. */
+ return NULL;
}
-
- interp->result =
- "This interpreter does not support stubs-enabled extensions.";
- interp->freeProc = TCL_STATIC;
- return NULL;
+ if (iPtr->stubTable->magic != TCL_STUB_MAGIC) {
+ /*
+ * We cannot acces interp->result and interp->freeProc
+ * any more: They will be gone in Tcl 9. In stead,
+ * assume that the iPtr->stubTable entry from Tcl_Interp
+ * and the Tcl_NewStringObj() and Tcl_SetObjResult() entries
+ * in the stub table don't change in Tcl 9. Need to add
+ * a test-case in Tcl 9 to assure that.
+ *
+ * The signature of Tcl_NewStringObj will change: the length
+ * parameter will be of type size_t. But passing the value
+ * (size_t)-1 will work, whatever the signature will be.
+ */
+ NewStringObjProc *newStringObj = (NewStringObjProc *)
+ iPtr->stubTable->tcl_NewStringObj;
+ iPtr->stubTable->tcl_SetObjResult(interp, newStringObj(
+ "This extension is compiled for Tcl 8.x", (size_t)-1));
+ return NULL;
+ }
+ return iPtr->stubTable;
}
/*