From 44869c9e35948e1217a567f936d638d98da61705 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