Fix [Bug 2637173] by consolidating bytearray purity check.

6 files changed, 53 insertions, 36 deletions

diff --git a/ChangeLog b/ChangeLog
index 4ba0279..ae48b2e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2009-07-12  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd):
+	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out
+	* generic/tclInt.h (TclIsPureByteArray):     the code to determine if
+	* generic/tclUtil.c (TclStringMatchObj):     it is safe to work with
+	byte arrays directly, so that we get the check correct _once_.
+
 	* generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed
 	* generic/tclOO.c (TclOOObjectCmdCore):	     the way that the cache is
 	managed so that when itcl does cunning things, those cunning things
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index bb0d3bd..2021b5b 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
  * 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.183 2009/05/06 20:16:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.184 2009/07/12 18:04:33 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1369,7 +1369,7 @@ StringIndexCmd(
 	 * bytearray for a result.
 	 */
 
-	if (objv[1]->typePtr == &tclByteArrayType) {
+	if (TclIsPureByteArray(objv[1])) {
 	    unsigned char uch = (unsigned char) ch;
 
 	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
@@ -2490,8 +2490,8 @@ StringEqualCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
@@ -2637,8 +2637,8 @@ StringCmpCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6c89523..aac36da 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.439 2009/06/03 23:12:11 das Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.440 2009/07/12 18:04:33 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -4516,8 +4516,8 @@ TclExecuteByteCode(
 	     */
 
 	    iResult = s1len = s2len = 0;
-	} else if ((valuePtr->typePtr == &tclByteArrayType)
-		&& (value2Ptr->typePtr == &tclByteArrayType)) {
+	} else if (TclIsPureByteArray(valuePtr)
+		&& TclIsPureByteArray(value2Ptr)) {
 	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
 	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
 	    iResult = memcmp(s1, s2,
@@ -4635,7 +4635,7 @@ TclExecuteByteCode(
 	}
 
 	if ((index >= 0) && (index < length)) {
-	    if (valuePtr->typePtr == &tclByteArrayType) {
+	    if (TclIsPureByteArray(valuePtr)) {
 		objResultPtr = Tcl_NewByteArrayObj(
 			Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
 	    } else if (valuePtr->bytes && length == valuePtr->length) {
@@ -4687,7 +4687,7 @@ TclExecuteByteCode(
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
-	} else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
 	    unsigned char *string1, *string2;
 	    int length1, length2;
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42915e0..007facd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,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.426 2009/06/30 14:21:43 das Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.427 2009/07/12 18:04:33 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -236,8 +236,15 @@ typedef struct Namespace {
     struct Namespace *parentPtr;/* Points to the namespace that contains this
 				 * one. NULL if this is the global
 				 * namespace. */
+#if 1
     Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
 				 * strings; values have type (Namespace *). */
+#else
+    Tcl_HashTable *childTablePtr;
+				/* Contains any child namespaces. Indexed by
+				 * strings; values have type (Namespace *). If
+				 * NULL, there are no children. */
+#endif
     long nsId;			/* Unique id for the namespace. */
     Tcl_Interp *interp;		/* The interpreter containing this
 				 * namespace. */
@@ -3847,6 +3854,23 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 	(numChars) = count; \
     } while (0);
 
+/*
+ *----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 09ac25a..7804e1f 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.126 2009/07/01 15:06:06 patthoyts Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.127 2009/07/12 18:04:33 dkf Exp $ */
 
 #include "tclInt.h"
 #include "tommath.h"
@@ -144,19 +144,6 @@ typedef struct String {
 	((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
 
 /*
- * Macro that encapsulates the logic that determines when it is safe to
- * interpret a string as a byte array directly. In summary, the object must be
- * a byte array and must not have a string representation (as the operations
- * that it is used in are defined on strings, not byte arrays). Theoretically
- * it is possible to also be efficient in the case where the object's bytes
- * field is filled by generation from the byte array (c.f. list canonicality)
- * but we don't do that at the moment since this is purely about efficiency.
- */
-
-#define IS_PURE_BYTE_ARRAY(objPtr) \
-	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
-
-/*
  * TCL STRING GROWTH ALGORITHM
  *
  * When growing strings (during an append, for example), the following growth
@@ -472,7 +459,7 @@ Tcl_GetCharLength(
      * perform the get-length operation.
      */
 
-    if (IS_PURE_BYTE_ARRAY(objPtr)) {
+    if (TclIsPureByteArray(objPtr)) {
 	int length;
 
 	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
@@ -538,7 +525,7 @@ Tcl_GetUniChar(
      * perform the indexing operation.
      */
 
-    if (IS_PURE_BYTE_ARRAY(objPtr)) {
+    if (TclIsPureByteArray(objPtr)) {
 	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
 
 	return (Tcl_UniChar) bytes[index];
@@ -669,7 +656,7 @@ Tcl_GetRange(
      * perform the substring operation.
      */
 
-    if (IS_PURE_BYTE_ARRAY(objPtr)) {
+    if (TclIsPureByteArray(objPtr)) {
 	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
 
 	return Tcl_NewByteArrayObj(bytes+first, last-first+1);
@@ -1247,7 +1234,7 @@ Tcl_AppendObjToObj(
      * information; this is a special-case optimization only.
      */
 
-    if (IS_PURE_BYTE_ARRAY(objPtr) && IS_PURE_BYTE_ARRAY(appendObjPtr)) {
+    if (TclIsPureByteArray(objPtr) && TclIsPureByteArray(appendObjPtr)) {
 	unsigned char *bytesDst, *bytesSrc;
 	int lengthSrc, lengthTotal;
 
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 881edca..862470f 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.110 2009/02/25 19:59:52 dgp Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.111 2009/07/12 18:04:33 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1747,9 +1747,10 @@ TclByteArrayMatch(
 
 int
 TclStringMatchObj(
-    Tcl_Obj *strObj,	/* string object. */
-    Tcl_Obj *ptnObj,	/* pattern object. */
-    int flags)		/* Only TCL_MATCH_NOCASE should be passed or 0. */
+    Tcl_Obj *strObj,		/* string object. */
+    Tcl_Obj *ptnObj,		/* pattern object. */
+    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
+				 * 0. */
 {
     int match, length, plen;
 
@@ -1766,8 +1767,7 @@ TclStringMatchObj(
 	udata = Tcl_GetUnicodeFromObj(strObj, &length);
 	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
 	match = TclUniCharMatch(udata, length, uptn, plen, flags);
-    } else if ((strObj->typePtr == &tclByteArrayType) 
-	    && (strObj->bytes == NULL) && !flags) {
+    } else if (TclIsPureByteArray(strObj) && !flags) {
 	unsigned char *data, *ptn;
 
 	data = Tcl_GetByteArrayFromObj(strObj, &length);