* generic/tcl.h: Revised Tcl_InitStubs() to restore Tcl 8.4

        * generic/tclPkg.c:     source compatibility with callers of
        * generic/tclStubLib.c: Tcl_InitStubs(interp, TCL_VERSION, 1).
        [Bug 1578344].

1 files changed, 45 insertions, 1 deletions

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