Compare commits

...
Author SHA1 Message Date
jan.nijtmans bddf737714 <i>on-hold at Don Porter's request</i>
change 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.
2012-11-18 17:12:35 +00:00
jan.nijtmans ef0fd808de <i>On hold at Don Porter's request</i>
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.
2012-11-18 17:04:38 +00:00
jan.nijtmans f4fb1d1752 <i>On-hold at Don Porter's request.</i>
change 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.
2012-11-18 16:54:16 +00:00
+26 -7
View File
@@ -32,20 +32,39 @@ const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
typedef Tcl_Obj *(NewStringObjProc) (const char *bytes, size_t length);
static const 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;
}
iPtr->result =
(char *)"This interpreter does not support stubs-enabled extensions.";
iPtr->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;
}
/*