summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h7
-rw-r--r--generic/tclPkg.c46
-rw-r--r--generic/tclStubLib.c22
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) {