From 592d64c6569bf3d85d3797d35a18183d7ff9d098 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 18 Nov 2012 16:54:16 +0000 Subject: On-hold at Don Porter's request. 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. --- generic/tclStubLib.c | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 1ab7ff3..b204306 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -38,19 +38,40 @@ TclIntPlatStubs *tclIntPlatStubsPtr = NULL; static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); +typedef Tcl_Obj *(NewStringObjProc) _ANSI_ARGS_((CONST char *bytes, + size_t length)); + + static TclStubs * HasStubSupport (interp) 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; } /* -- cgit v0.12 From 4edd261b39fc6c68c6795dcb88f7ec03d39aa6c6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 19 Nov 2012 08:30:11 +0000 Subject: Better solution for handling errors from Tcl 8.x compiled extensions. Works for existing ones. --- generic/tclLoad.c | 10 ++++++++-- generic/tclStubLib.c | 3 +-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5cacab1..a2cdc04 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -463,14 +463,20 @@ Tcl_LoadObjCmd( } code = pkgPtr->initProc(target); } - /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { - Tcl_TransferResult(target, code, interp); + Interp *iPtr = (Interp *) target; + if (iPtr->result != NULL) { + /* 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); + } goto done; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index bd8f6e7..be2c966 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -52,8 +52,7 @@ HasStubSupport( */ iPtr->stubTable->tcl_SetObjResult(interp, iPtr->stubTable->tcl_NewStringObj( - "This extension is compiled for Tcl 9.x", - TCL_NOSIZE)); + "This extension is compiled for Tcl 9.x", -1)); return NULL; } return iPtr->stubTable; -- cgit v0.12