diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 7 | ||||
| -rw-r--r-- | generic/tclPkg.c | 46 | ||||
| -rw-r--r-- | generic/tclStubLib.c | 22 |
3 files changed, 70 insertions, 5 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 5df7989..5ddbc1b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.234 2007/07/31 17:03:35 msofer Exp $ + * RCS: @(#) $Id: tcl.h,v 1.235 2007/09/17 14:50:43 dgp Exp $ */ #ifndef _TCL @@ -2216,7 +2216,7 @@ EXTERN CONST char* TclTomMathInitializeStubs(Tcl_Interp* interp, */ #define Tcl_InitStubs(interp, version, exact) \ - Tcl_PkgRequire(interp, "Tcl", version, exact) + Tcl_PkgInitStubsCheck(interp, version, exact) #endif @@ -2232,6 +2232,9 @@ EXTERN CONST char* TclTomMathInitializeStubs(Tcl_Interp* interp, EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv, Tcl_AppInitProc *appInitProc)); +EXTERN CONST char *Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *version, int exact)); + /* * Include the public function declarations that are accessible via the stubs * table. diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 8fc4d9f..b9874f5 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPkg.c,v 1.29 2007/09/11 17:46:07 dgp Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.30 2007/09/17 14:50:44 dgp Exp $ * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended @@ -1825,6 +1825,50 @@ RequirementSatisfied( } /* + *---------------------------------------------------------------------- + * + * Tcl_PkgInitStubsCheck -- + * + * This is a replacement routine for Tcl_InitStubs() that is called + * from code where -DUSE_TCL_STUBS has not been enabled. + * + * Results: + * Returns the version of a conforming stubs table, or NULL, if + * the table version doesn't satisfy the requested requirements, + * according to historical practice. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CONST char * +Tcl_PkgInitStubsCheck( + Tcl_Interp *interp, + CONST char * version, + int exact) +{ + CONST char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); + + if (exact && actualVersion) { + CONST char *p = version; + int count = 0; + + while (*p) { + count += !isdigit(*p++); + } + if (count == 1) { + if (0 != strncmp(version, actualVersion, strlen(version))) { + return NULL; + } + } else { + return Tcl_PkgPresent(interp, "Tcl", version, 1); + } + } + return actualVersion; +} +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 5389cfc..be2a1fa 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -10,7 +10,7 @@ * 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.15 2007/05/16 18:28:40 jenglish Exp $ + * RCS: @(#) $Id: tclStubLib.c,v 1.16 2007/09/17 14:50:44 dgp Exp $ */ /* @@ -95,10 +95,28 @@ Tcl_InitStubs( return NULL; } - actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData); + actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); if (actualVersion == NULL) { return NULL; } + if (exact) { + CONST char *p = version; + int count = 0; + + while (*p) { + count += !isdigit(*p++); + } + if (count == 1) { + if (0 != strncmp(version, actualVersion, strlen(version))) { + return NULL; + } + } else { + actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } + } + } tclStubsPtr = (TclStubs*)pkgData; if (tclStubsPtr->hooks) { |