Merge trunk.

Add more clarity why refCount should be decremented AFTER checking for <2. 
Protect 8.x extensions for being loadable in "novem", by changing Tcl_PkgProvide into a macro.

11 files changed, 77 insertions, 33 deletions

diff --git a/ChangeLog b/ChangeLog
index ee45fa8..8f5f10a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-11-13  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclCmdAH.c (CatchObjCmdCallback): do not decrRefCount
+	the newValuePtr sent to Tcl_ObjSetVar2: TOSV2 is 'fire and
+	forget', it decrs on its own. Fix for [Bug 3595576], found by
+	andrewsh.
+
 2012-12-13  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 198228b..76d5298 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -970,8 +970,9 @@ declare 272 {
 	    const char *name, const char *version, int exact,
 	    void *clientDataPtr)
 }
+# Changed to a macro, only (internally) exposed for legacy protection.
 declare 273 {
-    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+    int TclPkgProvide(Tcl_Interp *interp, const char *name,
 	    const char *version)
 }
 # TIP #268: The internally used new Require function is in slot 573.
diff --git a/generic/tcl.h b/generic/tcl.h
index f7d54b5..09191df 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2305,6 +2305,10 @@ TCLAPI void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
     /*
      * Use do/while0 idiom for optimum correctness without compiler warnings.
      * http://c2.com/cgi/wiki?TrivialDoWhileLoop
+     *
+     * Decrement refCount AFTER checking it for 0 or 1 (<2), because
+     * we cannot assume anymore that refCount is a signed type; In
+     * Tcl8 it was but in Tcl9 it is subject to change.
      */
 #   define Tcl_DecrRefCount(objPtr) \
 	do { \
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index ee1f97a..4be8b2a 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -224,7 +224,8 @@ CatchObjCmdCallback(
 
 	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
 		options, TCL_LEAVE_ERR_MSG)) {
-	    Tcl_DecrRefCount(options);
+	    /* Do not decrRefCount 'options', it was already done by
+	     * Tcl_ObjSetVar2 */
 	    return TCL_ERROR;
 	}
     }
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index d38296d..5c206aa 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -787,7 +787,7 @@ TCLAPI const char *	Tcl_PkgPresentEx(Tcl_Interp *interp,
 				const char *name, const char *version,
 				int exact, void *clientDataPtr);
 /* 273 */
-TCLAPI int		Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+TCLAPI int		TclPkgProvide(Tcl_Interp *interp, const char *name,
 				const char *version);
 /* 274 */
 TCLAPI const char *	Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
@@ -2076,7 +2076,7 @@ typedef struct TclStubs {
     const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
     const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
     const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
-    int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
+    int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
     const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
     void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
     int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
@@ -3005,8 +3005,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_PkgPresent) /* 271 */
 #define Tcl_PkgPresentEx \
 	(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
-#define Tcl_PkgProvide \
-	(tclStubsPtr->tcl_PkgProvide) /* 273 */
+#define TclPkgProvide \
+	(tclStubsPtr->tclPkgProvide) /* 273 */
 #define Tcl_PkgRequire \
 	(tclStubsPtr->tcl_PkgRequire) /* 274 */
 #define Tcl_SetErrorCodeVA \
@@ -3744,4 +3744,7 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
 	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 #endif
 
+#define Tcl_PkgProvide(interp, name, version) \
+	Tcl_PkgProvideEx(interp, name, version, NULL)
+
 #endif /* _TCLDECLS */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7c699c9..742d957 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3934,6 +3934,13 @@ typedef const char *TclDTraceStr;
  * Invalidate the string rep first so we can use the bytes value for our
  * pointer chain, and signal an obj deletion (as opposed to shimmering) with
  * 'length == -1'.
+ *
+ * Use do/while0 idiom for optimum correctness without compiler warnings.
+ * http://c2.com/cgi/wiki?TrivialDoWhileLoop
+ *
+ * Decrement refCount AFTER checking it for 0 or 1 (<2), because
+ * we cannot assume anymore that refCount is a signed type; In
+ * Tcl8 it was but in Tcl9 it is subject to change.
  */
 
 # define TclDecrRefCount(objPtr) \
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 5b09ddb..312524a 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -107,16 +107,6 @@ static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
  */
 
 int
-Tcl_PkgProvide(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
-				 * available. */
-    const char *name,		/* Name of package. */
-    const char *version)	/* Version string for package. */
-{
-    return Tcl_PkgProvideEx(interp, name, version, NULL);
-}
-
-int
 Tcl_PkgProvideEx(
     Tcl_Interp *interp,		/* Interpreter in which package is now
 				 * available. */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index c836f45..30c2b76 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -41,6 +41,30 @@
 #undef Tcl_FindExecutable
 #undef TclpGetPid
 #undef TclSockMinimumBuffers
+#undef TclPkgProvide
+
+#define TclPkgProvide pkgProvide
+static int TclPkgProvide(
+    Tcl_Interp *interp,		/* Interpreter in which package is now
+				 * available. */
+    const char *name,		/* Name of package. */
+    const char *version)	/* Version string for package. */
+{
+    /* In Tcl 9, Tcl_PkgProvide is a macro calling Tcl_PkgProvideEx.
+     * The only way this stub can be called is by an extension compiled
+     * against Tcl 8 headers. The Tcl_StubsInit() function already
+     * succeeded, so the extension author lied: It did something like:
+     *     Tcl_StubsInit(interp, "8.6-", 0)
+     * or
+     *     Tcl_StubsInit(interp, "8.6-9.1", 0)
+     *
+     * The best we can do is provide an error-message, as if the
+     * extension originally called:
+     *     Tcl_StubsInit(interp, "8", 0)
+     */
+	Tcl_PkgRequireEx(interp, "Tcl", "8", 0, NULL);
+	return TCL_ERROR;
+}
 
 #if defined(_WIN32) || defined(__CYGWIN__)
 #undef TclWinNToHS
@@ -919,7 +943,7 @@ const TclStubs tclStubs = {
     Tcl_ParseVar, /* 270 */
     Tcl_PkgPresent, /* 271 */
     Tcl_PkgPresentEx, /* 272 */
-    Tcl_PkgProvide, /* 273 */
+    TclPkgProvide, /* 273 */
     Tcl_PkgRequire, /* 274 */
     Tcl_SetErrorCodeVA, /* 275 */
     Tcl_VarEvalVA, /* 276 */
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 8fbe049..9c1176e 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -507,7 +507,7 @@ GenerateHeader(
  * ExtractHeader --
  *
  *	Take the values out of a gzip header and store them in a dictionary.
- *	SetValue is a helper function.
+ *	SetValue is a helper macro.
  *
  * Results:
  *	None.
@@ -518,18 +518,8 @@ GenerateHeader(
  *----------------------------------------------------------------------
  */
 
-static inline void
-SetValue(
-    Tcl_Obj *dictObj,
-    const char *key,
-    Tcl_Obj *value)
-{
-    Tcl_Obj *keyObj = Tcl_NewStringObj(key, -1);
-
-    Tcl_IncrRefCount(keyObj);
-    Tcl_DictObjPut(NULL, dictObj, keyObj, value);
-    TclDecrRefCount(keyObj);
-}
+#define SetValue(dictObj, key, value) \
+	Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
 
 static void
 ExtractHeader(
@@ -2119,9 +2109,6 @@ ZlibCmd(
 	}
 	if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL,
 		headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
-	    if (headerDictObj) {
-		TclDecrRefCount(headerDictObj);
-	    }
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 3011597..0517e5f 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -68,6 +68,12 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
 test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
     catch foo bar baz spaz
 } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
+test cmdAH-1.4 {Bug 3595576} {
+    catch {catch {} -> noSuchNs::var}
+} 1
+test cmdAH-1.5 {Bug 3595576} {
+    catch {catch error -> noSuchNs::var}
+} 1
 
 test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
     cd foo bar
diff --git a/tests/zlib.test b/tests/zlib.test
index 5f1e5fc..891dba0 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -826,6 +826,20 @@ test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
 } -cleanup {
     removeFile $file
 } -result {1000 /foo/bar 0}
+test zlib-11.3 {Bug 3595576 variant} -setup {
+    set file [makeFile {} test.input]
+} -constraints zlib -body {
+    set f [open $file wb]
+    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+	[string repeat "hello" 1000]
+    close $f
+    set f [open $file rb]
+    set d [read $f]
+    close $f
+    zlib gunzip $d -header noSuchNs::foo
+} -cleanup {
+    removeFile $file
+} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
 
 ::tcltest::cleanupTests
 return