* generic/tkConsole.c: Revised callers of Tcl_InitStubs() to account

        * generic/tkMain.c:     for restored compatible support for the call
        * generic/tkWindow.c:   Tcl_InitStubs(interp, TCL_VERSION, 1).  Also
        revised Tcl_PkgRequire() call for Tcl so that, for example, a Tk
        library built against Tcl 8.5.1 headers will not refuse to [load]
        into a Tcl 8.5.0 interpreter.  [Tcl Bug 1578344].

        * generic/tk.h:         Revised Tk_InitStubs() to restore Tk 8.4
        * generic/tkStubLib.c:  source compatibility with callers of
        * generic/tkWindow.c:   Tk_InitStubs(interp, TK_VERSION, 1).

5 files changed, 75 insertions, 11 deletions

diff --git a/generic/tk.h b/generic/tk.h
index b75f136..3139d2d 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tk.h,v 1.99 2007/05/30 17:39:24 dgp Exp $
+ * RCS: @(#) $Id: tk.h,v 1.100 2007/09/17 14:58:04 dgp Exp $
  */
 
 #ifndef _TK
@@ -1486,11 +1486,13 @@ typedef struct Tk_ElementSpec {
 
 const char *		Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
 			    const char *version, int exact));
+const char *		Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
+			    const char *version, int exact));
 
 #ifndef USE_TK_STUBS
 
 #define Tk_InitStubs(interp, version, exact) \
-    Tcl_PkgRequire(interp, "Tk", version, exact)
+    Tk_PkgInitStubsCheck(interp, version, exact)
 
 #endif
 
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index f5969ee..94ee6cb 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.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: tkConsole.c,v 1.33 2007/09/11 17:46:41 dgp Exp $
+ * RCS: @(#) $Id: tkConsole.c,v 1.34 2007/09/17 14:58:04 dgp Exp $
  */
 
 #include "tk.h"
@@ -233,7 +233,7 @@ Tk_InitConsoleChannels(
      * only an issue when Tk is loaded dynamically.
      */
 
-    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
         return;
     }
 
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 19ec30a..509e527 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -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: tkMain.c,v 1.26 2007/09/11 17:46:41 dgp Exp $
+ * RCS: @(#) $Id: tkMain.c,v 1.27 2007/09/17 14:58:04 dgp Exp $
  */
 
 #include <ctype.h>
@@ -110,7 +110,7 @@ Tk_MainEx(
      * only an issue when Tk is loaded dynamically.
      */
 
-    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
 	abort();
     }
 
diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c
index 93033ae..6c884c5 100644
--- a/generic/tkStubLib.c
+++ b/generic/tkStubLib.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: tkStubLib.c,v 1.15 2007/09/07 00:34:53 dgp Exp $
+ * RCS: @(#) $Id: tkStubLib.c,v 1.16 2007/09/17 14:58:04 dgp Exp $
  */
 
 /*
@@ -85,11 +85,29 @@ Tk_InitStubs(
     CONST char *actualVersion;
     TkStubs **stubsPtrPtr = &tkStubsPtr;	/* squelch warning */
 
-    actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact,
+    actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0,
 	    (ClientData *) stubsPtrPtr);
     if (!actualVersion) {
 	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, "Tk", version, 1, NULL);
+            if (actualVersion == NULL) {
+                return NULL;
+            }
+        }
+    }
 
     if (!tkStubsPtr) {
 	Tcl_SetResult(interp,
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index fb68d21..d9da81a 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWindow.c,v 1.85 2007/09/11 18:24:41 dgp Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.86 2007/09/17 14:58:05 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -2948,7 +2948,7 @@ Initialize(
      * only an issue when Tk is loaded dynamically.
      */
 
-    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -3181,7 +3181,7 @@ Initialize(
 	geometry = NULL;
     }
 
-    if (Tcl_PkgRequire(interp, "Tcl", TCL_PATCH_LEVEL, 0) == NULL) {
+    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
 	code = TCL_ERROR;
 	goto done;
     }
@@ -3273,6 +3273,50 @@ tkInit");
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PkgInitStubsCheck --
+ *
+ *	This is a replacement routine for Tk_InitStubs() that is called
+ *	from code where -DUSE_TK_STUBS has not been enabled.
+ *
+ * Results:
+ *	Returns the version of a conforming Tk stubs table, or NULL, if
+ *	the table version doesn't satisfy the requested requirements,
+ *	according to historical practice.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_PkgInitStubsCheck(
+    Tcl_Interp *interp,
+    CONST char * version,
+    int exact)
+{
+    CONST char *actualVersion = Tcl_PkgRequire(interp, "Tk", 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, "Tk", version, 1);
+	}
+    }
+    return actualVersion;
+}
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4