summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-07-12 18:04:33 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-07-12 18:04:33 (GMT)
commit02457f7d6507f76fac8b308899e6592ab8214cb3 (patch)
tree84e622e144e045fb36d18b1ef70c6561ee1a920f
parentfde10a8fbff3c774f95f668f51b6d60c1489d50d (diff)
downloadtcl-02457f7d6507f76fac8b308899e6592ab8214cb3.zip
tcl-02457f7d6507f76fac8b308899e6592ab8214cb3.tar.gz
tcl-02457f7d6507f76fac8b308899e6592ab8214cb3.tar.bz2
Fix [Bug 2637173] by consolidating bytearray purity check.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclExecute.c10
-rw-r--r--generic/tclInt.h26
-rw-r--r--generic/tclStringObj.c23
-rw-r--r--generic/tclUtil.c12
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);