merge updates from HEAD

7 files changed, 102 insertions, 35 deletions

diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index f57779d..bc61e14 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -875,7 +875,7 @@ lexescape(
 	 * Ugly heuristic (first test is "exactly 1 digit?")
 	 */
 
-	if (v->now - save == 0 || (int)c <= v->nsubexp) {
+	if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) {
 	    NOTE(REG_UBACKREF);
 	    RETV(BACKREF, (chr)c);
 	}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 8c69ecc..8816110 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,11 +15,13 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.5 2007/10/15 18:38:06 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.6 2007/11/01 16:25:56 dgp Exp $
  */
 
 #include "tclInt.h"
 #include "tclRegexp.h"
+
+static int		UniCharIsAscii(int character);
 
 /*
  *----------------------------------------------------------------------
@@ -1489,18 +1491,7 @@ Tcl_StringObjCmd(
 	    chcomp = Tcl_UniCharIsAlpha;
 	    break;
 	case STR_IS_ASCII:
-	    for (; string1 < end; string1++, failat++) {
-		/*
-		 * This is a valid check in unicode, because all bytes less
-		 * than 0xC0 are single byte chars (but isascii limits that
-		 * def'n to 0x80).
-		 */
-
-		if (*((unsigned char *)string1) >= 0x80) {
-		    result = 0;
-		    break;
-		}
-	    }
+	    chcomp = UniCharIsAscii;
 	    break;
 	case STR_IS_BOOL:
 	case STR_IS_TRUE:
@@ -2446,6 +2437,13 @@ Tcl_StringObjCmd(
     return TCL_OK;
 }
 
+static int
+UniCharIsAscii(
+    int character)
+{
+    return (character >= 0) && (character < 0x80);
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 069a0ba..f5f1a1e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.70.2.9 2007/10/27 04:11:47 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.70.2.10 2007/11/01 16:25:57 dgp Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -916,8 +916,6 @@ MODULE_SCOPE void	TclRegisterAuxDataType(AuxDataType *typePtr);
 MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
 			    char *bytes, int length, int flags);
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
-MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    Command *cmdPtr);
 MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index d0465aa..d9f901b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEncoding.c,v 1.55 2007/04/17 14:49:53 dkf Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.55.2.1 2007/11/01 16:25:57 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -575,6 +575,50 @@ TclInitEncodingSubsystem(void)
     type.clientData	= NULL;
     Tcl_CreateEncoding(&type);
 
+    /*
+     * Need the iso8859-1 encoding in order to process binary data, so force
+     * it to always be embedded. Note that this encoding *must* be a proper
+     * table encoding or some of the escape encodings crash! Hence the ugly
+     * code to duplicate the structure of a table encoding here.
+     */
+
+    {
+	TableEncodingData *dataPtr = (TableEncodingData *)
+		ckalloc(sizeof(TableEncodingData));
+	unsigned size;
+	unsigned short i;
+
+	memset(dataPtr, 0, sizeof(TableEncodingData));
+	dataPtr->fallback = '?';
+
+	size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
+	dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+	memset(dataPtr->toUnicode, 0, size);
+	dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+	memset(dataPtr->fromUnicode, 0, size);
+
+	dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
+	dataPtr->fromUnicode[0] = (unsigned short *)
+		(dataPtr->fromUnicode + 256);
+	for (i=1 ; i<256 ; i++) {
+	    dataPtr->toUnicode[i] = emptyPage;
+	    dataPtr->fromUnicode[i] = emptyPage;
+	}
+
+	for (i=0 ; i<256 ; i++) {
+	    dataPtr->toUnicode[0][i] = i;
+	    dataPtr->fromUnicode[0][i] = i;
+	}
+
+	type.encodingName	= "iso8859-1";
+	type.toUtfProc		= TableToUtfProc;
+	type.fromUtfProc	= TableFromUtfProc;
+	type.freeProc		= TableFreeProc;
+	type.nullSize		= 1;
+	type.clientData		= dataPtr;
+	Tcl_CreateEncoding(&type);
+    }
+
     encodingsInitialized = 1;
 }
 
@@ -2030,7 +2074,7 @@ BinaryProc(
     *srcReadPtr = srcLen;
     *dstWrotePtr = srcLen;
     *dstCharsPtr = srcLen;
-    memcpy((void *) dst, (void *) src, (size_t) srcLen);
+    memcpy(dst, src, (size_t) srcLen);
     return result;
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a8a609f..a00c8c2 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.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: tclInt.h,v 1.310.2.11 2007/10/02 20:11:56 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.310.2.12 2007/11/01 16:25:57 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2534,6 +2534,8 @@ MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
 			    Tcl_Obj *cmdPrefix);
 MODULE_SCOPE void	TclSetBignumIntRep (Tcl_Obj *objPtr,
 			    mp_int *bignumValue);
+MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Command *cmdPtr);
 MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 			    Tcl_Obj *newValue, Tcl_Encoding encoding);
 MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7eca2c5..eed9d9c 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.8 2007/09/17 15:03:45 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.9 2007/11/01 16:25:57 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2371,7 +2371,7 @@ Tcl_FindCommand(
      * signal an error.
      */
 
-    if (flags & TCL_GLOBAL_ONLY) {
+    if ((flags & TCL_GLOBAL_ONLY) || !strncmp(name, "::", 2)) {
 	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
     } else if (contextNsPtr != NULL) {
 	cxtNsPtr = (Namespace *) contextNsPtr;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 3c1e161..d0b903b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.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: tclUtil.c,v 1.82.2.1 2007/10/16 03:50:31 dgp Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.82.2.2 2007/11/01 16:25:57 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1145,14 +1145,15 @@ Tcl_ConcatObj(
     char *p;
     char *element;
     char *concatStr;
-    Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr, *resPtr;
 
     /*
-     * Check first to see if all the items are of list type. If so, we will
-     * concat them together as lists, and return a list object. This is only
-     * valid when the lists have no current string representation, since we
-     * don't know what the original type was. An original string rep may have
-     * lost some whitespace info when converted which could be important.
+     * Check first to see if all the items are of list type or empty. If so,
+     * we will concat them together as lists, and return a list object. This
+     * is only valid when the lists have no current string representation,
+     * since we don't know what the original type was. An original string rep
+     * may have lost some whitespace info when converted which could be
+     * important. 
      */
 
     for (i = 0;  i < objc;  i++) {
@@ -1160,7 +1161,12 @@ Tcl_ConcatObj(
 
 	objPtr = objv[i];
 	if (objPtr->typePtr != &tclListType) {
-	    break;
+	    Tcl_GetString(objPtr);
+	    if (objPtr->length) {
+		break;
+	    } else {
+		continue;
+	    }
 	}
 	listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
 	if (objPtr->bytes != NULL && !listRepPtr->canonicalFlag) {
@@ -1171,19 +1177,38 @@ Tcl_ConcatObj(
 	Tcl_Obj **listv;
 	int listc;
 
-	objPtr = Tcl_NewListObj(0, NULL);
+	resPtr = NULL;
 	for (i = 0;  i < objc;  i++) {
 	    /*
 	     * Tcl_ListObjAppendList could be used here, but this saves us a
 	     * bit of type checking (since we've already done it). Use of
 	     * INT_MAX tells us to always put the new stuff on the end. It
 	     * will be set right in Tcl_ListObjReplace.
+	     * Note that all objs at this point are either lists or have an
+	     * empty string rep.
 	     */
-
-	    Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
-	    Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
+	    
+	    objPtr = objv[i];
+	    if (objPtr->bytes && !objPtr->length) {
+		continue;
+	    }
+	    Tcl_ListObjGetElements(NULL, objPtr, &listc, &listv);
+	    if (listc) {
+		if (resPtr) {
+		    Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
+		} else {
+		    if (Tcl_IsShared(objPtr)) {
+			resPtr = TclListObjCopy(NULL, objPtr);
+		    } else {
+			resPtr = objPtr;
+		    }
+		}
+	    }
+	}
+	if (!resPtr) {
+	    resPtr = Tcl_NewObj();
 	}
-	return objPtr;
+	return resPtr;
     }
 
     /*