diff options
Diffstat (limited to 'generic/tclStubLib.c')
| -rw-r--r-- | generic/tclStubLib.c | 140 |
1 files changed, 72 insertions, 68 deletions
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f246f35..859cbf9 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -1,60 +1,35 @@ -/* +/* * tclStubLib.c -- * - * Stub object that will be statically linked into extensions that wish + * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclStubLib.c,v 1.8 2004/04/06 22:25:55 dgp Exp $ + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * We need to ensure that we use the stub macros so that this file contains - * no references to any of the stub functions. This will make it possible - * to build an extension that references Tcl_InitStubs but doesn't end up - * including the rest of the stub functions. - */ +#include "tclInt.h" -#ifndef USE_TCL_STUBS -#define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS +MODULE_SCOPE const TclStubs *tclStubsPtr; +MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; +MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; +MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; -#include "tclInt.h" +const TclStubs *tclStubsPtr = NULL; +const TclPlatStubs *tclPlatStubsPtr = NULL; +const TclIntStubs *tclIntStubsPtr = NULL; +const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; /* - * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub - * functions should be built as non-exported symbols. + * Use our own isDigit to avoid linking to libc on windows */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -TclStubs *tclStubsPtr = NULL; -TclPlatStubs *tclPlatStubsPtr = NULL; -TclIntStubs *tclIntStubsPtr = NULL; -TclIntPlatStubs *tclIntPlatStubsPtr = NULL; - -static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); - -static TclStubs * -HasStubSupport (interp) - Tcl_Interp *interp; +static int isDigit(const int c) { - Interp *iPtr = (Interp *) interp; - - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; - } - interp->result = "This interpreter does not support stubs-enabled extensions."; - interp->freeProc = TCL_STATIC; - - return NULL; + return (c >= '0' && c <= '9'); } /* @@ -62,52 +37,73 @@ HasStubSupport (interp) * * Tcl_InitStubs -- * - * Tries to initialise the stub table pointers and ensures that - * the correct version of Tcl is loaded. + * Tries to initialise the stub table pointers and ensures that the + * correct version of Tcl is loaded. * * Results: - * The actual version of Tcl that satisfies the request, or - * NULL to indicate that an error occurred. + * The actual version of Tcl that satisfies the request, or NULL to + * indicate that an error occurred. * * Side effects: * Sets the stub table pointers. * *---------------------------------------------------------------------- */ - -#ifdef Tcl_InitStubs #undef Tcl_InitStubs -#endif - -CONST char * -Tcl_InitStubs (interp, version, exact) - Tcl_Interp *interp; - CONST char *version; - int exact; +MODULE_SCOPE const char * +Tcl_InitStubs( + Tcl_Interp *interp, + const char *version, + int exact) { - CONST char *actualVersion = NULL; - TclStubs *tmp; - TclStubs **tmpp; + Interp *iPtr = (Interp *) interp; + const char *actualVersion = NULL; + ClientData pkgData = NULL; + const TclStubs *stubsPtr = iPtr->stubTable; /* - * We can't optimize this check by caching tclStubsPtr because - * that prevents apps from being able to load/unload Tcl dynamically - * multiple times. [Bug 615304] + * We can't optimize this check by caching tclStubsPtr because that + * prevents apps from being able to load/unload Tcl dynamically multiple + * times. [Bug 615304] */ - tclStubsPtr = HasStubSupport(interp); - if (!tclStubsPtr) { + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } - /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - tmpp = &tmp; - actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, - (ClientData *) tmpp); + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); if (actualVersion == NULL) { - tclStubsPtr = NULL; return NULL; } + if (exact) { + const char *p = version; + int count = 0; + + while (*p) { + count += !isDigit(*p++); + } + if (count == 1) { + const char *q = actualVersion; + + p = version; + while (*p && (*p == *q)) { + p++; q++; + } + if (*p || isDigit(*q)) { + /* Construct error message */ + stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + return NULL; + } + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } + } + } + tclStubsPtr = (TclStubs *)pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; @@ -118,6 +114,14 @@ Tcl_InitStubs (interp, version, exact) tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; } - + return actualVersion; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |