diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-11-19 08:30:11 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-11-19 08:30:11 (GMT) |
| commit | 4edd261b39fc6c68c6795dcb88f7ec03d39aa6c6 (patch) | |
| tree | 5863b58bdecb0ae12d258385e3bbb5cbcd640a8f | |
| parent | ba3714a1c6b066ad7d41fcb1dadf84ade25f1499 (diff) | |
| download | tcl-4edd261b39fc6c68c6795dcb88f7ec03d39aa6c6.zip tcl-4edd261b39fc6c68c6795dcb88f7ec03d39aa6c6.tar.gz tcl-4edd261b39fc6c68c6795dcb88f7ec03d39aa6c6.tar.bz2 | |
Better solution for handling errors from Tcl 8.x compiled extensions. Works for existing ones.
| -rw-r--r-- | generic/tclLoad.c | 10 | ||||
| -rw-r--r-- | 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; |