merge trunk

13 files changed, 137 insertions, 101 deletions

diff --git a/ChangeLog b/ChangeLog
index 9b4772c..6f8c8ae 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2012-11-28  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
+	for complex option resolution that has fewer problems with more
+	finicky compilers.
+
+2012-11-26  Reinhard Max  <max@suse.de>
+
+	* unix/tclUnixSock.c: Factor out creation of the -sockname and
+	-peername lists from TcpGetOptionProc() to TcpHostPortList().
+	Make it robust against implementations of getnameinfo() that error
+	out if reverse mapping fails instead of falling back to the
+	numeric representation.
+
 2012-11-20  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index be63e0e..9c93fb2 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1224,12 +1224,7 @@ TclCompileSwitchCmd(
 	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
 		    &(bodyTokenArray[numWords].start), &bytes,
 		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
-	    abort:
-		ckfree((char *) bodyToken);
-		ckfree((char *) bodyTokenArray);
-		ckfree((char *) bodyLines);
-		ckfree((char *) bodyContLines);
-		return TCL_ERROR;
+		goto abort;
 	    }
 
 	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
@@ -1254,7 +1249,12 @@ TclCompileSwitchCmd(
 	    numWords++;
 	}
 	if (numWords % 2) {
-	    goto abort;
+	abort:
+	    ckfree((char *) bodyToken);
+	    ckfree((char *) bodyTokenArray);
+	    ckfree((char *) bodyLines);
+	    ckfree((char *) bodyContLines);
+	    return TCL_ERROR;
 	}
     } else if (numWords % 2 || numWords == 0) {
 	/*
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 309e232..08615a7 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -42,7 +42,7 @@
  * TYPE_BRACE -		Character is a curly brace (either left or right).
  */
 
-const char charTypeTable[] = {
+const char tclCharTypeTable[] = {
     /*
      * Negative character values, from -128 to -1:
      */
diff --git a/generic/tclParse.h b/generic/tclParse.h
index be1ab15..20c609c 100644
--- a/generic/tclParse.h
+++ b/generic/tclParse.h
@@ -12,6 +12,6 @@
 #define TYPE_CLOSE_BRACK	0x20
 #define TYPE_BRACE		0x40
 
-#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
+#define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)]
 
-MODULE_SCOPE const char charTypeTable[];
+MODULE_SCOPE const char tclCharTypeTable[];
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index f569820..91012fd 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -41,9 +41,7 @@ HasStubSupport(
     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
 	return iPtr->stubTable;
     }
-
-    iPtr->result =
-	    (char *)"This interpreter does not support stubs-enabled extensions.";
+    iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
     iPtr->freeProc = TCL_STATIC;
     return NULL;
 }
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 11490f1..8fbe049 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2177,29 +2177,36 @@ ZlibStreamSubcmd(
 	FMT_INFLATE
     };
     int i, format, mode = 0, option, level;
+    enum objIndices {
+	OPT_COMPRESSION_DICTIONARY = 0,
+	OPT_GZIP_HEADER = 1,
+	OPT_COMPRESSION_LEVEL = 2,
+	OPT_END = -1
+    };
+    Tcl_Obj *obj[3] = { NULL, NULL, NULL };
+#define compDictObj	obj[OPT_COMPRESSION_DICTIONARY]
+#define gzipHeaderObj	obj[OPT_GZIP_HEADER]
+#define levelObj	obj[OPT_COMPRESSION_LEVEL]
     typedef struct {
 	const char *name;
-	Tcl_Obj **valueVar;
+	enum objIndices offset;
     } OptDescriptor;
-    Tcl_Obj *compDictObj = NULL;
-    Tcl_Obj *gzipHeaderObj = NULL;
-    Tcl_Obj *levelObj = NULL;
-    const OptDescriptor compressionOpts[] = {
-	{ "-dictionary", &compDictObj },
-	{ "-level", &levelObj },
-	{ NULL, NULL }
+    static const OptDescriptor compressionOpts[] = {
+	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
+	{ "-level",	 OPT_COMPRESSION_LEVEL },
+	{ NULL, OPT_END }
     };
-    const OptDescriptor gzipOpts[] = {
-	{ "-header", &gzipHeaderObj },
-	{ "-level", &levelObj },
-	{ NULL, NULL }
+    static const OptDescriptor gzipOpts[] = {
+	{ "-header",	 OPT_GZIP_HEADER },
+	{ "-level",	 OPT_COMPRESSION_LEVEL },
+	{ NULL, OPT_END }
     };
-    const OptDescriptor expansionOpts[] = {
-	{ "-dictionary", &compDictObj },
-	{ NULL, NULL }
+    static const OptDescriptor expansionOpts[] = {
+	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
+	{ NULL, OPT_END }
     };
-    const OptDescriptor gunzipOpts[] = {
-	{ NULL, NULL }
+    static const OptDescriptor gunzipOpts[] = {
+	{ NULL, OPT_END }
     };
     const OptDescriptor *desc = NULL;
     Tcl_ZlibStream zh;
@@ -2262,13 +2269,7 @@ ZlibStreamSubcmd(
 		sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	*desc[option].valueVar = objv[i+1];
-
-	/*
-	 * Drop the cache on the option name; table address not constant.
-	 */
-
-	TclFreeIntRep(objv[i]);
+	obj[desc[option].offset] = objv[i+1];
     }
 
     /*
@@ -2300,6 +2301,9 @@ ZlibStreamSubcmd(
     }
     Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
     return TCL_OK;
+#undef compDictObj
+#undef gzipHeaderObj
+#undef levelObj
 }
 
 /*
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 0e4568d..4b0a9bc 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3.4 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 02da62f..83ec9d3 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.3.4
+    variable Version 2.3.5
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -601,7 +601,9 @@ namespace eval tcltest {
 	}
     }
     proc configure args {
-	RemoveAutoConfigureTraces
+	if {[llength $args] > 1} {
+	    RemoveAutoConfigureTraces
+	}
 	set code [catch {Configure {*}$args} msg]
 	return -code $code $msg
     }
diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt
index 5020506..f12111d 100644
--- a/pkgs/package.list.txt
+++ b/pkgs/package.list.txt
@@ -19,3 +19,8 @@ thread Thread
 tdbc TDBC
 Tdbc TDBC
 TDBC TDBC
+# Drivers for TDBC
+tdbcmysql	tdbc::mysql
+tdbcodbc	tdbc::odbc
+tdbcpostgres	tdbc::postgres
+tdbcsqlite3-	tdbc::sqlite3
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 4f66646..df05759 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -848,8 +848,8 @@ install-libraries: libraries
 	    done;
 	@echo "Installing package msgcat 1.5.0 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.0.tm;
-	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm;
+	@echo "Installing package tcltest 2.3.5 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;
 
 	@echo "Installing package platform 1.0.10 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.10.tm;
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index f73c164..4be3d7b 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -12,15 +12,6 @@
  */
 
 #include <dl.h>
-
-/*
- * On some HP machines, dl.h defines EXTERN; remove that definition.
- */
-
-#ifdef EXTERN
-#   undef EXTERN
-#endif
-
 #include "tclInt.h"
 
 /*
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 102c620..31daa62 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -627,6 +627,74 @@ TcpClose2Proc(
 /*
  *----------------------------------------------------------------------
  *
+ * TcpHostPortList --
+ *
+ *	This function is called by the -gethostname and -getpeername
+ *	switches of TcpGetOptionProc() to add three list elements
+ *	with the textual representation of the given address to the
+ *	given DString.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Adds three elements do dsPtr
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TcpHostPortList(
+    Tcl_Interp *interp,
+    Tcl_DString *dsPtr,
+    address addr,
+    socklen_t salen)
+{
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+    char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV];
+    int flags = 0;
+
+    getnameinfo(&addr.sa, salen,
+                nhost, sizeof(nhost), nport, sizeof(nport),
+                NI_NUMERICHOST | NI_NUMERICSERV);
+    Tcl_DStringAppendElement(dsPtr, nhost);
+    /*
+     * We don't want to resolve INADDR_ANY and sin6addr_any; they
+     * can sometimes cause problems (and never have a name).
+     */
+    if (addr.sa.sa_family == AF_INET) {
+        if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
+            flags |= NI_NUMERICHOST;
+        }
+#ifndef NEED_FAKE_RFC2553
+    } else if (addr.sa.sa_family == AF_INET6) {
+        if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr,
+                                &in6addr_any))
+            || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) &&
+                addr.sa6.sin6_addr.s6_addr[12] == 0 &&
+                addr.sa6.sin6_addr.s6_addr[13] == 0 &&
+                addr.sa6.sin6_addr.s6_addr[14] == 0 &&
+                addr.sa6.sin6_addr.s6_addr[15] == 0)) {
+            flags |= NI_NUMERICHOST;
+        }
+#endif /* NEED_FAKE_RFC2553 */
+    }
+    /* Check if reverse DNS has been switched off globally */
+    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+        flags |= NI_NUMERICHOST;
+    }
+    if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) {
+        /* Reverse mapping worked */
+        Tcl_DStringAppendElement(dsPtr, host);
+    } else {
+        /* Reverse mappong failed - use the numeric rep once more */
+        Tcl_DStringAppendElement(dsPtr, nhost);
+    }
+    Tcl_DStringAppendElement(dsPtr, nport);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TcpGetOptionProc --
  *
  *	Computes an option value for a TCP socket based channel, or a list of
@@ -656,10 +724,7 @@ TcpGetOptionProc(
 				 * initialized by caller. */
 {
     TcpState *statePtr = instanceData;
-    char host[NI_MAXHOST], port[NI_MAXSERV];
     size_t len = 0;
-    int reverseDNS = 0;
-#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
 
     if (optionName != NULL) {
 	len = strlen(optionName);
@@ -686,10 +751,6 @@ TcpGetOptionProc(
 	return TCL_OK;
     }
 
-    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
-        reverseDNS = NI_NUMERICHOST;
-    }
-    
     if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
 	    (strncmp(optionName, "-peername", len) == 0))) {
         address peername;
@@ -700,14 +761,7 @@ TcpGetOptionProc(
 		Tcl_DStringAppendElement(dsPtr, "-peername");
 		Tcl_DStringStartSublist(dsPtr);
 	    }
-            
-	    getnameinfo(&peername.sa, size, host, sizeof(host), NULL, 0,
-                    NI_NUMERICHOST);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    getnameinfo(&peername.sa, size, host, sizeof(host), port,
-                    sizeof(port), reverseDNS | NI_NUMERICSERV);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    Tcl_DStringAppendElement(dsPtr, port);
+            TcpHostPortList(interp, dsPtr, peername, size);
 	    if (len) {
                 return TCL_OK;
             }
@@ -745,40 +799,8 @@ TcpGetOptionProc(
 	for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
 	    size = sizeof(sockname);
 	    if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
-                int flags = reverseDNS;
-
 		found = 1;
-                getnameinfo(&sockname.sa, size, host, sizeof(host), NULL, 0,
-                        NI_NUMERICHOST);
-                Tcl_DStringAppendElement(dsPtr, host);
-
-                /*
-                 * We don't want to resolve INADDR_ANY and sin6addr_any; they
-                 * can sometimes cause problems (and never have a name).
-                 */
-
-                flags |= NI_NUMERICSERV;
-                if (sockname.sa.sa_family == AF_INET) {
-                    if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
-                        flags |= NI_NUMERICHOST;
-                    }
-#ifndef NEED_FAKE_RFC2553
-                } else if (sockname.sa.sa_family == AF_INET6) {
-                    if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
-                                &in6addr_any))
-                        || (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr) &&
-                            sockname.sa6.sin6_addr.s6_addr[12] == 0 &&
-                            sockname.sa6.sin6_addr.s6_addr[13] == 0 &&
-                            sockname.sa6.sin6_addr.s6_addr[14] == 0 &&
-                            sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
-                        flags |= NI_NUMERICHOST;
-                    }
-#endif /* NEED_FAKE_RFC2553 */
-                }
-		getnameinfo(&sockname.sa, size, host, sizeof(host), port,
-                        sizeof(port), flags);
-		Tcl_DStringAppendElement(dsPtr, host);
-		Tcl_DStringAppendElement(dsPtr, port);
+                TcpHostPortList(interp, dsPtr, sockname, size);
 	    }
 	}
         if (found) {
diff --git a/win/Makefile.in b/win/Makefile.in
index dacbbb5..8cfb68c 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -643,8 +643,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    done;
 	@echo "Installing package msgcat 1.5.0 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.0.tm;
-	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
+	@echo "Installing package tcltest 2.3.5 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
 	@echo "Installing package platform 1.0.10 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm;
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";