summaryrefslogtreecommitdiffstats
path: root/generic/tclOOStubLib.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-07 14:40:56 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-07 14:40:56 (GMT)
commitf6f2a3b144eb75edbc33ea0c15c40bc40e0158bd (patch)
tree2bd8baf6c11fe4d3786667b319b3d80f37e291e6 /generic/tclOOStubLib.c
parent7acea3af7b9aead1af0702058bb8fca92ab11449 (diff)
downloadtcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.zip
tcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.tar.gz
tcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.tar.bz2
Restrict the stub library to only use Tcl_PkgRequireEx, Tcl_ResetResult and Tcl_AppendResult, not any other function.
This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions.
Diffstat (limited to 'generic/tclOOStubLib.c')
-rw-r--r--generic/tclOOStubLib.c72
1 files changed, 28 insertions, 44 deletions
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 55f2378..921aced 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -2,19 +2,6 @@
* ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
*/
-/*
- * We need to ensure that we use the tcl stub macros so that this file
- * contains no references to any of the tcl stub functions.
- */
-
-#undef USE_TCL_STUBS
-#define USE_TCL_STUBS
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#define USE_TCLOO_STUBS 1
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
@@ -35,51 +22,48 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
* to indicate that an error occurred.
*
* Side effects:
- * Sets the stub table pointer.
+ * Sets the stub table pointers.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char *
TclOOInitializeStubs(
- Tcl_Interp *interp, const char *version)
+ Tcl_Interp *interp,
+ const char *version)
{
int exact = 0;
const char *packageName = "TclOO";
const char *errMsg = NULL;
- ClientData clientData = NULL;
- const char *actualVersion =
- Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);
+ TclOOStubs *stubsPtr = NULL;
+ const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, exact, &stubsPtr);
- if (clientData == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error loading %s package; package not present or incomplete",
- packageName));
+ if (actualVersion == NULL) {
return NULL;
+ }
+ if (stubsPtr == NULL) {
+ errMsg = "missing stub table pointer";
} else {
- const TclOOStubs * const stubsPtr = clientData;
- const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ?
- stubsPtr->hooks->tclOOIntStubs : NULL;
-
- if (!actualVersion) {
- return NULL;
- }
-
- if (!stubsPtr || !intStubsPtr) {
- errMsg = "missing stub table pointer";
- goto error;
- }
-
tclOOStubsPtr = stubsPtr;
- tclOOIntStubsPtr = intStubsPtr;
+ if (stubsPtr->hooks) {
+ tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
+ } else {
+ tclOOIntStubsPtr = NULL;
+ }
return actualVersion;
-
- error:
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
- " (requested version '%s', loaded version '%s'): %s",
- packageName, version, actualVersion, errMsg));
- return NULL;
}
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */