summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog44
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCompile.c64
-rw-r--r--generic/tclDecls.h8
-rw-r--r--generic/tclDictObj.c58
-rw-r--r--generic/tclIndexObj.c10
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclListObj.c137
-rw-r--r--generic/tclUtil.c945
-rw-r--r--library/http/http.tcl3
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/msgcat/msgcat.tcl36
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/tzdata/Africa/Cairo178
-rw-r--r--tests/list.test4
-rw-r--r--unix/Makefile.in8
-rw-r--r--win/Makefile.in8
-rwxr-xr-xwin/configure58
-rw-r--r--win/tcl.m415
21 files changed, 1026 insertions, 568 deletions
diff --git a/ChangeLog b/ChangeLog
index a26e005..78c78c0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,47 @@
+2011-06-01 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclUtil.c: fix for [Bug 3309871]: Valgrind finds:
+ invalid read in TclMaxListLength()
+
+2011-05-25 Don Porter <dgp@users.sourceforge.net>
+
+ * library/msgcat/msgcat.tcl: Backport improvements to msgcat
+ * library/msgcat/pkgIndex.tcl: package. Bump to 1.4.4
+ * unix/Makefile.in
+ * win/Makefile.in
+
+2011-05-24 Venkat Iyer <venkat@comit.com>
+
+ * library/tzdata/Africa/Cairo: Update to Olson tzdata2011g
+
+2011-05-17 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed
+ * generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation
+ of my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter.
+ When a bytecode was grown during jump fixup the pc -> command line
+ mapping was not updated. When things aligned just wrong the mapping
+ would direct command A to the data for command B, with a different
+ number of arguments.
+
+2011-05-10 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.h: New internal routines TclScanElement() and
+ * generic/tclUtil.c: TclConvertElement() are rewritten guts of
+ machinery to produce string rep of lists. The new routines avoid
+ and correct [Bug 3173086]. See comments for much more detail.
+
+ * generic/tclDictObj.c: Update all callers.
+ * generic/tclIndexObj.c:
+ * generic/tclListObj.c:
+ * generic/tclUtil.c:
+ * tests/list.test:
+
+2011-05-09 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c: Revise empty string tests so that we avoid
+ potentially expensive string rep generations, especially for dicts.
+
2011-05-07 Miguel Sofer <msofer@users.sf.net>
* generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled
diff --git a/generic/tcl.decls b/generic/tcl.decls
index b33e808..20e9575 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -774,10 +774,10 @@ declare 217 generic {
void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 generic {
- int Tcl_ScanElement(CONST char *str, int *flagPtr)
+ int Tcl_ScanElement(CONST char *src, int *flagPtr)
}
declare 219 generic {
- int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
+ int Tcl_ScanCountedElement(CONST char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 generic {
diff --git a/generic/tcl.h b/generic/tcl.h
index 790b7ac..015995c 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -956,8 +956,6 @@ typedef struct Tcl_DString {
* is safe to leave the hash unquoted when the element is not the first
* element of a list, and this flag can be used by the caller to indicate
* that condition.
- * (Careful! If you change these flag values be sure to change the definitions
- * at the front of tclUtil.c).
*/
#define TCL_DONT_USE_BRACES 1
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 71bd45c..750c9e2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4764,6 +4764,10 @@ TclArgumentBCEnter(interp,objv,objc,codePtr,cfPtr,pc)
* have to save them at compile time.
*/
+ if (ePtr->nline != objc) {
+ Tcl_Panic ("TIP 280 data structure inconsistency");
+ }
+
for (word = 1; word < objc; word++) {
if (ePtr->line[word] >= 0) {
int isnew;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 2d8d58c..7f11e0e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3020,6 +3020,70 @@ TclFixupForwardJump(
rangePtr->type);
}
}
+
+ /*
+ * TIP #280: Adjust the mapping from PC values to the per-command
+ * information about arguments and their line numbers.
+ *
+ * Note: We cannot simply remove an out-of-date entry and then reinsert
+ * with the proper PC, because then we might overwrite another entry which
+ * was at that location. Therefore we pull (copy + delete) all effected
+ * entries (beyond the fixed PC) into an array, update them there, and at
+ * last reinsert them all.
+ */
+
+ {
+ ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+
+ /* A helper structure */
+
+ typedef struct {
+ int pc;
+ int cmd;
+ } MAP;
+
+ /*
+ * And the helper array. At most the whole hashtable is placed into
+ * this.
+ */
+
+ MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
+
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry* hPtr;
+ int n, k, isnew;
+
+ /*
+ * Phase I: Locate the affected entries, and save them in adjusted
+ * form to the array. This removes them from the hash.
+ */
+
+ for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+
+ map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
+ map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));
+
+ if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
+ Tcl_DeleteHashEntry(hPtr);
+ map [n].pc += 3;
+ n++;
+ }
+ }
+
+ /*
+ * Phase II: Re-insert the modified entries into the hash.
+ */
+
+ for (k=0;k<n;k++) {
+ hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
+ Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
+ }
+
+ ckfree ((char *) map);
+ }
+
return 1; /* the jump was grown */
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b741475..4517d01 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1312,12 +1312,12 @@ EXTERN void Tcl_ResetResult(Tcl_Interp *interp);
#ifndef Tcl_ScanElement_TCL_DECLARED
#define Tcl_ScanElement_TCL_DECLARED
/* 218 */
-EXTERN int Tcl_ScanElement(CONST char *str, int *flagPtr);
+EXTERN int Tcl_ScanElement(CONST char *src, int *flagPtr);
#endif
#ifndef Tcl_ScanCountedElement_TCL_DECLARED
#define Tcl_ScanCountedElement_TCL_DECLARED
/* 219 */
-EXTERN int Tcl_ScanCountedElement(CONST char *str, int length,
+EXTERN int Tcl_ScanCountedElement(CONST char *src, int length,
int *flagPtr);
#endif
#ifndef Tcl_SeekOld_TCL_DECLARED
@@ -3661,8 +3661,8 @@ typedef struct TclStubs {
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
void (*tcl_Release) (ClientData clientData); /* 216 */
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
- int (*tcl_ScanElement) (CONST char *str, int *flagPtr); /* 218 */
- int (*tcl_ScanCountedElement) (CONST char *str, int length, int *flagPtr); /* 219 */
+ int (*tcl_ScanElement) (CONST char *src, int *flagPtr); /* 218 */
+ int (*tcl_ScanCountedElement) (CONST char *src, int length, int *flagPtr); /* 219 */
int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 33fec57..06c5754 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -460,19 +460,27 @@ UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = dictPtr->internalRep.otherValuePtr;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
- int numElems, i, length;
+ int i, length, bytesNeeded = 0;
char *elem, *dst;
+ const int maxFlags = UINT_MAX / sizeof(int);
/*
* This field is the most useful one in the whole hash structure, and it
* is not exposed by any API function...
*/
- numElems = dict->table.numEntries * 2;
+ int numElems = dict->table.numEntries * 2;
+
+ /* Handle empty list case first, simplifies what follows */
+ if (numElems == 0) {
+ dictPtr->bytes = tclEmptyStringRep;
+ dictPtr->length = 0;
+ return;
+ }
/*
* Pass 1: estimate space, gather flags.
@@ -480,55 +488,63 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
+ } else if (numElems > maxFlags) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
}
- dictPtr->length = 1;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
* Assume that cPtr is never NULL since we know the number of array
* elements already.
*/
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i]) + 1;
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
- dictPtr->length += Tcl_ScanCountedElement(elem, length,
- &flagPtr[i+1]) + 1;
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
}
+ if (bytesNeeded > INT_MAX - numElems + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += numElems;
/*
* Pass 2: copy into string rep buffer.
*/
- dictPtr->bytes = ckalloc((unsigned) dictPtr->length);
+ dictPtr->length = bytesNeeded - 1;
+ dictPtr->bytes = ckalloc((unsigned) bytesNeeded);
dst = dictPtr->bytes;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- *(dst++) = ' ';
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
+ flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i+1] | TCL_DONT_QUOTE_HASH);
- *(dst++) = ' ';
+ dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
+ *dst++ = ' ';
}
+ dictPtr->bytes[dictPtr->length] = '\0';
+
if (flagPtr != localFlags) {
ckfree((char *) flagPtr);
}
- if (dst == dictPtr->bytes) {
- *dst = 0;
- } else {
- *(--dst) = 0;
- }
- dictPtr->length = dst - dictPtr->bytes;
}
/*
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 595132c..3e37f0f 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -537,12 +537,13 @@ Tcl_WrongNumArgs(
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp, (unsigned)len);
- len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
@@ -591,12 +592,13 @@ Tcl_WrongNumArgs(
*/
elementStr = TclGetStringFromObj(objv[i], &elemLen);
- len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ flags = 0;
+ len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,(unsigned) len);
- len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
Tcl_AppendToObj(objPtr, quotedElementStr, len);
TclStackFree(interp, quotedElementStr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d196d96..5152b7d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2573,6 +2573,8 @@ MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
MODULE_SCOPE ContLineLoc* TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
+MODULE_SCOPE int TclConvertElement(CONST char *src, int length,
+ char *dst, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
@@ -2781,6 +2783,8 @@ MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
+MODULE_SCOPE int TclScanElement(CONST char *string, int length,
+ int *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c4061b3..17aa256 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -460,24 +460,13 @@ Tcl_ListObjGetElements(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- /*
- * Don't get the string version of a dictionary; that transformation
- * is not lossy, but is expensive.
- */
-
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -587,18 +576,12 @@ Tcl_ListObjAppendElement(
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -702,18 +685,12 @@ Tcl_ListObjIndex(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*objPtrPtr = NULL;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -761,27 +738,12 @@ Tcl_ListObjLength(
register List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
- int result, length;
+ int result;
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- /*
- * It's tempting to just report 2*length as the list length
- * of this dict, but arguably that's false since the max sizes
- * for dicts and lists are not the same, so some dicts don't
- * actually convert to lists, and it's good to get that error
- * back from the SetListFromAny() call below instead of a false
- * indication we can treat the value as a list. ([llength $val]
- * often used as a "listiness" test)
- */
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
*intPtr = 0;
return TCL_OK;
}
-
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -849,14 +811,7 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (listPtr->typePtr != &tclListType) {
- int length;
-
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
if (objc) {
Tcl_SetListObj(listPtr, objc, NULL);
} else {
@@ -1551,14 +1506,9 @@ TclListObjSetElement(
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
if (listPtr->typePtr != &tclListType) {
- int length, result;
+ int result;
- if (listPtr->typePtr == &tclDictType) {
- (void) Tcl_DictObjSize(NULL, listPtr, &length);
- } else {
- (void) TclGetStringFromObj(listPtr, &length);
- }
- if (!length) {
+ if (listPtr->bytes == tclEmptyStringRep) {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
@@ -1856,19 +1806,29 @@ UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
- register int i;
+ int i, length, bytesNeeded = 0;
char *elem, *dst;
- int length;
Tcl_Obj **elemPtrs;
/*
- * Convert each element of the list to string form and then convert it to
- * proper list element form, adding it to the result buffer.
+ * Mark the list as being canonical; although it will now have a string
+ * rep, it is one we derived through proper "canonical" quoting and so
+ * it's known to be free from nasties relating to [concat] and [eval].
*/
+ listRepPtr->canonicalFlag = 1;
+
+ /* Handle empty list case first, so rest of the routine is simpler */
+
+ if (numElems == 0) {
+ listPtr->bytes = tclEmptyStringRep;
+ listPtr->length = 0;
+ return;
+ }
+
/*
* Pass 1: estimate space, gather flags.
*/
@@ -1876,54 +1836,41 @@ UpdateStringOfList(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
+ /* We know numElems <= LIST_MAX, so this is safe. */
flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int));
}
- listPtr->length = 1;
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
elem = TclGetStringFromObj(elemPtrs[i], &length);
- listPtr->length += Tcl_ScanCountedElement(elem, length, flagPtr+i)+1;
-
- /*
- * Check for continued sanity. [Bug 1267380]
- */
-
- if (listPtr->length < 1) {
- Tcl_Panic("string representation size exceeds sane bounds");
+ bytesNeeded += TclScanElement(elem, length, flagPtr+i);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
}
+ if (bytesNeeded > INT_MAX - numElems + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += numElems;
/*
* Pass 2: copy into string rep buffer.
*/
- listPtr->bytes = ckalloc((unsigned) listPtr->length);
+ listPtr->length = bytesNeeded - 1;
+ listPtr->bytes = ckalloc((unsigned) bytesNeeded);
dst = listPtr->bytes;
for (i = 0; i < numElems; i++) {
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
elem = TclGetStringFromObj(elemPtrs[i], &length);
- dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- *dst = ' ';
- dst++;
+ dst += TclConvertElement(elem, length, dst, flagPtr[i]);
+ *dst++ = ' ';
}
+ listPtr->bytes[listPtr->length] = '\0';
+
if (flagPtr != localFlags) {
ckfree((char *) flagPtr);
}
- if (dst == listPtr->bytes) {
- *dst = 0;
- } else {
- dst--;
- *dst = 0;
- }
- listPtr->length = dst - listPtr->bytes;
-
- /*
- * Mark the list as being canonical; although it has a string rep, it is
- * one we derived through proper "canonical" quoting and so it's known to
- * be free from nasties relating to [concat] and [eval].
- */
-
- listRepPtr->canonicalFlag = 1;
}
/*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index bd543b0..f5c2926 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -26,31 +26,71 @@ static ProcessGlobalValue executableName = {
};
/*
- * The following values are used in the flags returned by Tcl_ScanElement and
- * used by Tcl_ConvertElement. The values TCL_DONT_USE_BRACES and
- * TCL_DONT_QUOTE_HASH are defined in tcl.h; make sure neither value overlaps
- * with any of the values below.
- *
- * TCL_DONT_USE_BRACES - 1 means the string mustn't be enclosed in
- * braces (e.g. it contains unmatched braces, or
- * ends in a backslash character, or user just
- * doesn't want braces); handle all special
- * characters by adding backslashes.
- * USE_BRACES - 1 means the string contains a special
- * character that can be handled simply by
- * enclosing the entire argument in braces.
- * BRACES_UNMATCHED - 1 means that braces aren't properly matched in
- * the argument.
+ * The following values are used in the flags arguments of Tcl*Scan*Element and
+ * Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and TCL_DONT_QUOTE_HASH
+ * are defined in tcl.h, like so:
+ *
+#define TCL_DONT_USE_BRACES 1
+#define TCL_DONT_QUOTE_HASH 8
+ *
+ * Those are public flag bits which callers of the public routines
+ * Tcl_Convert*Element() can use to indicate:
+ *
+ * TCL_DONT_USE_BRACES - 1 means the caller is insisting that brace
+ * quoting not be used when converting the list
+ * element.
* TCL_DONT_QUOTE_HASH - 1 means the caller insists that a leading hash
* character ('#') should *not* be quoted. This
* is appropriate when the caller can guarantee
* the element is not the first element of a
* list, so [eval] cannot mis-parse the element
* as a comment.
+ *
+ * The remaining values which can be carried by the flags of these routines
+ * are for internal use only. Make sure they do not overlap with the public
+ * values above.
+ *
+ * The Tcl*Scan*Element() routines make a determination which of 4 modes of
+ * conversion is most appropriate for Tcl*Convert*Element() to perform, and
+ * sets two bits of the flags value to indicate the mode selected.
+ *
+ * CONVERT_NONE The element needs no quoting. Its literal string
+ * is suitable as is.
+ * CONVERT_BRACE The conversion should be enclosing the literal string
+ * in braces.
+ * CONVERT_ESCAPE The conversion should be using backslashes to escape
+ * any characters in the string that require it.
+ * CONVERT_MASK A mask value used to extract the conversion mode from
+ * the flags argument.
+ * Also indicates a strange conversion mode where all
+ * special characters are escaped with backslashes
+ * *except for braces*. This is a strange and unnecessary
+ * case, but it's part of the historical way in which
+ * lists have been formatted in Tcl. To experiment with
+ * removing this case, set the value of COMPAT to 0.
+ *
+ * One last flag value is used only by callers of TclScanElement(). The flag
+ * value produced by a call to Tcl*Scan*Element() will never leave this bit
+ * set.
+ *
+ * CONVERT_ANY The caller of TclScanElement() declares it can make
+ * no promise about what public flags will be passed to
+ * the matching call of TclConvertElement(). As such,
+ * TclScanElement() has to determine the worst case
+ * destination buffer length over all possibilities, and
+ * in other cases this means an overestimate of the
+ * required size.
+ *
+ * For more details, see the comments on the Tcl*Scan*Element and
+ * Tcl*Convert*Element routines.
*/
-#define USE_BRACES 2
-#define BRACES_UNMATCHED 4
+#define COMPAT 1
+#define CONVERT_NONE 0
+#define CONVERT_BRACE 2
+#define CONVERT_ESCAPE 4
+#define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE)
+#define CONVERT_ANY 16
/*
* The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
@@ -87,6 +127,239 @@ Tcl_ObjType tclEndOffsetType = {
};
/*
+ * * STRING REPRESENTATION OF LISTS * * *
+ *
+ * The next several routines implement the conversions of strings to and
+ * from Tcl lists. To understand their operation, the rules of parsing
+ * and generating the string representation of lists must be known. Here
+ * we describe them in one place.
+ *
+ * A list is made up of zero or more elements. Any string is a list if
+ * it is made up of alternating substrings of element-separating ASCII
+ * whitespace and properly formatted elements.
+ *
+ * The ASCII characters which can make up the whitespace between list
+ * elements are:
+ *
+ * \u0009 \t TAB
+ * \u000A \n NEWLINE
+ * \u000B \v VERTICAL TAB
+ * \u000C \f FORM FEED
+ * \u000D \r CARRIAGE RETURN
+ * \u0020 SPACE
+ *
+ * NOTE: differences between this and other places where Tcl defines a role
+ * for "whitespace".
+ *
+ * * Unlike command parsing, here NEWLINE is just another whitespace
+ * character; its role as a command terminator in a script has no
+ * importance here.
+ *
+ * * Unlike command parsing, the BACKSLASH NEWLINE sequence is not
+ * considered to be a whitespace character.
+ *
+ * * Other Unicode whitespace characters (recognized by
+ * [string is space] or Tcl_UniCharIsSpace()) do not play any role
+ * as element separators in Tcl lists.
+ *
+ * * The NUL byte ought not appear, as it is not in strings properly
+ * encoded for Tcl, but if it is present, it is not treated as
+ * separating whitespace, or a string terminator. It is just
+ * another character in a list element.
+ *
+ * The interpretaton of a formatted substring as a list element follows
+ * rules similar to the parsing of the words of a command in a Tcl script.
+ * Backslash substitution plays a key role, and is defined exactly as it is
+ * in command parsing. The same routine, TclParseBackslash() is used in both
+ * command parsing and list parsing.
+ *
+ * NOTE: This means that if and when backslash substitution rules ever
+ * change for command parsing, the interpretation of strings as lists also
+ * changes.
+ *
+ * Backslash substitution replaces an "escape sequence" of one or more
+ * characters starting with
+ * \u005c \ BACKSLASH
+ * with a single character. The one character escape sequent case happens
+ * only when BACKSLASH is the last character in the string. In all other
+ * cases, the escape sequence is at least two characters long.
+ *
+ * The formatted substrings are interpreted as element values according to
+ * the following cases:
+ *
+ * * If the first character of a formatted substring is
+ * \u007b { OPEN BRACE
+ * then the end of the substring is the matching
+ * \u007d } CLOSE BRACE
+ * character, where matching is determined by counting nesting levels,
+ * and not including any brace characters that are contained within a
+ * backslash escape sequence in the nesting count. Having found the
+ * matching brace, all characters between the braces are the string
+ * value of the element. If no matching close brace is found before the
+ * end of the string, the string is not a Tcl list. If the character
+ * following the close brace is not an element separating whitespace
+ * character, or the end of the string, then the string is not a Tcl list.
+ *
+ * NOTE: this differs from a brace-quoted word in the parsing of a
+ * Tcl command only in its treatment of the backslash-newline sequence.
+ * In a list element, the literal characters in the backslash-newline
+ * sequence become part of the element value. In a script word,
+ * conversion to a single SPACE character is done.
+ *
+ * NOTE: Most list element values can be represented by a formatted
+ * substring using brace quoting. The exceptions are any element value
+ * that includes an unbalanced brace not in a backslash escape sequence,
+ * and any value that ends with a backslash not itself in a backslash
+ * escape sequence.
+ *
+ * * If the first character of a formatted substring is
+ * \u0022 " QUOTE
+ * then the end of the substring is the next QUOTE character, not counting
+ * any QUOTE characters that are contained within a backslash escape
+ * sequence. If no next QUOTE is found before the end of the string, the
+ * string is not a Tcl list. If the character following the closing QUOTE
+ * is not an element separating whitespace character, or the end of the
+ * string, then the string is not a Tcl list. Having found the limits
+ * of the substring, the element value is produced by performing backslash
+ * substitution on the character sequence between the open and close QUOTEs.
+ *
+ * NOTE: Any element value can be represented by this style of formatting,
+ * given suitable choice of backslash escape sequences.
+ *
+ * * All other formatted substrings are terminated by the next element
+ * separating whitespace character in the string. Having found the limits
+ * of the substring, the element value is produced by performing backslash
+ * substitution on it.
+ *
+ * NOTE: Any element value can be represented by this style of formatting,
+ * given suitable choice of backslash escape sequences, with one exception.
+ * The empty string cannot be represented as a list element without the use
+ * of either braces or quotes to delimit it.
+ *
+ * This collection of parsing rules is implemented in the routine
+ * TclFindElement().
+ *
+ * In order to produce lists that can be parsed by these rules, we need
+ * the ability to distinguish between characters that are part of a list
+ * element value from characters providing syntax that define the structure
+ * of the list. This means that our code that generates lists must at a
+ * minimum be able to produce escape sequences for the 10 characters
+ * identified above that have significance to a list parser.
+ *
+ * * * CANONICAL LISTS * * * * *
+ *
+ * In addition to the basic rules for parsing strings into Tcl lists, there
+ * are additional properties to be met by the set of list values that are
+ * generated by Tcl. Such list values are often said to be in "canonical
+ * form":
+ *
+ * * When any canonical list is evaluated as a Tcl script, it is a script
+ * of either zero commands (an empty list) or exactly one command. The
+ * command word is exactly the first element of the list, and each argument
+ * word is exactly one of the following elements of the list. This means
+ * that any characters that have special meaning during script evaluation
+ * need special treatment when canonical lists are produced:
+ *
+ * * Whitespace between elements may not include NEWLINE.
+ * * The command terminating character,
+ * \u003b ; SEMICOLON
+ * must be BRACEd, QUOTEd, or escaped so that it does not terminate
+ * the command prematurely.
+ * * Any of the characters that begin substitutions in scripts,
+ * \u0024 $ DOLLAR
+ * \u005b [ OPEN BRACKET
+ * \u005c \ BACKSLASH
+ * need to be BRACEd or escaped.
+ * * In any list where the first character of the first element is
+ * \u0023 # HASH
+ * that HASH character must be BRACEd, QUOTEd, or escaped so that it
+ * does not convert the command into a comment.
+ * * Any list element that contains the character sequence
+ * BACKSLASH NEWLINE cannot be formatted with BRACEs. The
+ * BACKSLASH character must be represented by an escape
+ * sequence, and unless QUOTEs are used, the NEWLINE must
+ * be as well.
+ *
+ * * It is also guaranteed that one can use a canonical list as a building
+ * block of a larger script within command substitution, as in this example:
+ * set script "puts \[[list $cmd $arg]]"; eval $script
+ * To support this usage, any appearance of the character
+ * \u005d ] CLOSE BRACKET
+ * in a list element must be BRACEd, QUOTEd, or escaped.
+ *
+ * * Finally it is guaranteed that enclosing a canonical list in braces
+ * produces a new value that is also a canonical list. This new list has
+ * length 1, and its only element is the original canonical list. This
+ * same guarantee also makes it possible to construct scripts where an
+ * argument word is given a list value by enclosing the canonical form
+ * of that list in braces:
+ * set script "puts {[list $one $two $three]}"; eval $script
+ * This sort of coding was once fairly common, though it's become more
+ * idiomatic to see the following instead:
+ * set script [list puts [list $one $two $three]]; eval $script
+ * In order to support this guarantee, every canonical list must have
+ * balance when counting those braces that are not in escape sequences.
+ *
+ * Within these constraints, the canonical list generation routines
+ * TclScanElement() and TclConvertElement() attempt to generate the string
+ * for any list that is easiest to read. When an element value is itself
+ * acceptable as the formatted substring, it is usually used (CONVERT_NONE).
+ * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE)
+ * is usually preferred over the use of escape sequences (CONVERT_ESCAPE).
+ * There are some exceptions to both of these preferences for reasons of
+ * code simplicity, efficiency, and continuation of historical habits.
+ * Canonical lists never use the QUOTE formatting to delimit their elements
+ * because that form of quoting does not nest, which makes construction of
+ * nested lists far too much trouble. Canonical lists always use only a
+ * single SPACE character for element-separating whitespace.
+ *
+ * * * FUTURE CONSIDERATIONS * * *
+ *
+ * When a list element requires quoting or escaping due to a CLOSE BRACKET
+ * character or an internal QUOTE character, a strange formatting mode is
+ * recommended. For example, if the value "a{b]c}d" is converted by the
+ * usual modes:
+ *
+ * CONVERT_BRACE: a{b]c}d => {a{b]c}d}
+ * CONVERT_ESCAPE: a{b]c}d => a\{b\]c\}d
+ *
+ * we get perfectly usable formatted list elements. However, this is not
+ * what Tcl releases have been producing. Instead, we have:
+ *
+ * CONVERT_MASK: a{b]c}d => a{b\]c}d
+ *
+ * where the CLOSE BRACKET is escaped, but the BRACEs are not. The same
+ * effect can be seen replacing ] with " in this example. There does not
+ * appear to be any functional or aesthetic purpose for this strange
+ * additional mode. The sole purpose I can see for preserving it is to
+ * keep generating the same formatted lists programmers have become accustomed
+ * to, and perhaps written tests to expect. That is, compatibility only.
+ * The additional code complexity required to support this mode is significant.
+ * The lines of code supporting it are delimited in the routines below with
+ * #if COMPAT directives. This makes it easy to experiment with eliminating
+ * this formatting mode simply with "#define COMPAT 0" above. I believe
+ * this is worth considering.
+ *
+ * Another consideration is the treatment of QUOTE characters in list elements.
+ * TclConvertElement() must have the ability to produce the escape sequence
+ * \" so that when a list element begins with a QUOTE we do not confuse
+ * that first character with a QUOTE used as list syntax to define list
+ * structure. However, that is the only place where QUOTE characters need
+ * quoting. In this way, handling QUOTE could really be much more like
+ * the way we handle HASH which also needs quoting and escaping only in
+ * particular situations. Following up this could increase the set of
+ * list elements that can use the CONVERT_NONE formatting mode.
+ *
+ * More speculative is that the demands of canonical list form require brace
+ * balance for the list as a whole, while the current implementation achieves
+ * this by establishing brace balance for every element.
+ *
+ * Finally, a reminder that the rules for parsing and formatting lists are
+ * closely tied together with the rules for parsing and evaluating scripts,
+ * and will need to evolve in sync.
+ */
+
+/*
*----------------------------------------------------------------------
*
* TclMaxListLength --
@@ -137,7 +410,7 @@ TclMaxListLength(
bytes++;
numBytes -= (numBytes != -1);
} while (numBytes && TclIsSpaceProc(*bytes));
- if (numBytes == 0) {
+ if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
break;
}
/* (*bytes) is non-space; return to counting state */
@@ -176,7 +449,7 @@ TclMaxListLength(
* that's part of the element. If this is the last argument in the list,
* then *nextPtr will point just after the last character in the list
* (i.e., at the character at list+listLength). If sizePtr is non-NULL,
- * *sizePtr is filled in with the number of characters in the element. If
+ * *sizePtr is filled in with the number of bytes in the element. If
* the element is in braces, then *elementPtr will point to the character
* after the opening brace and *sizePtr will not include either of the
* braces. If there isn't an element in the list, *sizePtr will be zero,
@@ -562,9 +835,9 @@ Tcl_SplitList(
* enclosing braces) to make the string into a valid Tcl list element.
*
* Results:
- * The return value is an overestimate of the number of characters that
+ * The return value is an overestimate of the number of bytes that
* will be needed by Tcl_ConvertElement to produce a valid list element
- * from string. The word at *flagPtr is filled in with a value needed by
+ * from src. The word at *flagPtr is filled in with a value needed by
* Tcl_ConvertElement when doing the actual conversion.
*
* Side effects:
@@ -575,11 +848,11 @@ Tcl_SplitList(
int
Tcl_ScanElement(
- register CONST char *string,/* String to convert to list element. */
+ register CONST char *src, /* String to convert to list element. */
register int *flagPtr) /* Where to store information to guide
* Tcl_ConvertCountedElement. */
{
- return Tcl_ScanCountedElement(string, -1, flagPtr);
+ return Tcl_ScanCountedElement(src, -1, flagPtr);
}
/*
@@ -590,13 +863,13 @@ Tcl_ScanElement(
* This function is a companion function to Tcl_ConvertCountedElement. It
* scans a string to see what needs to be done to it (e.g. add
* backslashes or enclosing braces) to make the string into a valid Tcl
- * list element. If length is -1, then the string is scanned up to the
- * first null byte.
+ * list element. If length is -1, then the string is scanned from src up
+ * to the first null byte.
*
* Results:
- * The return value is an overestimate of the number of characters that
+ * The return value is an overestimate of the number of bytes that
* will be needed by Tcl_ConvertCountedElement to produce a valid list
- * element from string. The word at *flagPtr is filled in with a value
+ * element from src. The word at *flagPtr is filled in with a value
* needed by Tcl_ConvertCountedElement when doing the actual conversion.
*
* Side effects:
@@ -607,79 +880,119 @@ Tcl_ScanElement(
int
Tcl_ScanCountedElement(
- CONST char *string, /* String to convert to Tcl list element. */
- int length, /* Number of bytes in string, or -1. */
+ CONST char *src, /* String to convert to Tcl list element. */
+ int length, /* Number of bytes in src, or -1. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
- int flags, nestingLevel;
- register CONST char *p, *lastChar;
+ int flags = CONVERT_ANY;
+ int numBytes = TclScanElement(src, length, &flags);
- /*
- * This function and Tcl_ConvertElement together do two things:
- *
- * 1. They produce a proper list, one that will yield back the argument
- * strings when evaluated or when disassembled with Tcl_SplitList. This
- * is the most important thing.
- *
- * 2. They try to produce legible output, which means minimizing the use
- * of backslashes (using braces instead). However, there are some
- * situations where backslashes must be used (e.g. an element like
- * "{abc": the leading brace will have to be backslashed. For each
- * element, one of three things must be done:
- *
- * (a) Use the element as-is (it doesn't contain any special
- * characters). This is the most desirable option.
- *
- * (b) Enclose the element in braces, but leave the contents alone.
- * This happens if the element contains embedded space, or if it
- * contains characters with special interpretation ($, [, ;, or \),
- * or if it starts with a brace or double-quote, or if there are no
- * characters in the element.
- *
- * (c) Don't enclose the element in braces, but add backslashes to
- * prevent special interpretation of special characters. This is a
- * last resort used when the argument would normally fall under
- * case (b) but contains unmatched braces. It also occurs if the
- * last character of the argument is a backslash or if the element
- * contains a backslash followed by newline.
- *
- * The function figures out how many bytes will be needed to store the
- * result (actually, it overestimates). It also collects information about
- * the element in the form of a flags word.
- *
- * Note: list elements produced by this function and
- * Tcl_ConvertCountedElement must have the property that they can be
- * enclosing in curly braces to make sub-lists. This means, for example,
- * that we must not leave unmatched curly braces in the resulting list
- * element. This property is necessary in order for functions like
- * Tcl_DStringStartSublist to work.
- */
+ *flagPtr = flags;
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclScanElement --
+ *
+ * This function is a companion function to TclConvertElement. It
+ * scans a string to see what needs to be done to it (e.g. add
+ * backslashes or enclosing braces) to make the string into a valid Tcl
+ * list element. If length is -1, then the string is scanned from src up
+ * to the first null byte. A NULL value for src is treated as an
+ * empty string. The incoming value of *flagPtr is a report from the
+ * caller what additional flags it will pass to TclConvertElement().
+ *
+ * Results:
+ * The recommended formatting mode for the element is determined and
+ * a value is written to *flagPtr indicating that recommendation. This
+ * recommendation is combined with the incoming flag values in *flagPtr
+ * set by the caller to determine how many bytes will be needed by
+ * TclConvertElement() in which to write the formatted element following
+ * the recommendation modified by the flag values. This number of bytes
+ * is the return value of the routine. In some situations it may be
+ * an overestimate, but so long as the caller passes the same flags
+ * to TclConvertElement(), it will be large enough.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- nestingLevel = 0;
- flags = 0;
- if (string == NULL) {
- string = "";
- }
- if (length == -1) {
- length = strlen(string);
+int
+TclScanElement(
+ CONST char *src, /* String to convert to Tcl list element. */
+ int length, /* Number of bytes in src, or -1. */
+ int *flagPtr) /* Where to store information to guide
+ * Tcl_ConvertElement. */
+{
+ CONST char *p = src;
+ int nestingLevel = 0; /* Brace nesting count */
+ int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something
+ needs protection or escape. */
+ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some
+ * reason bare or brace-quoted form fails. */
+ int extra = 0; /* Count of number of extra bytes needed for
+ * formatted element, assuming we use escape
+ * sequences in formatting. */
+ int bytesNeeded; /* Buffer length computed to complete the
+ * element formatting in the selected mode. */
+#if COMPAT
+ int preferEscape = 0; /* Use preferences to track whether to use */
+ int preferBrace = 0; /* CONVERT_MASK mode. */
+ int braceCount = 0; /* Count of all braces '{' '}' seen. */
+#endif
+
+ if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
+ /* Empty string element must be brace quoted. */
+ *flagPtr = CONVERT_BRACE;
+ return 2;
}
- lastChar = string + length;
- p = string;
- if ((p == lastChar) || (*p == '{') || (*p == '"')) {
- flags |= USE_BRACES;
+
+ if ((*p == '{') || (*p == '"')) {
+ /*
+ * Must escape or protect so leading character of value is not
+ * misinterpreted as list element delimiting syntax.
+ */
+ forbidNone = 1;
+#if COMPAT
+ preferBrace = 1;
+#endif
}
- for (; p < lastChar; p++) {
+
+ while (length) {
switch (*p) {
case '{':
+#if COMPAT
+ braceCount++;
+#endif
+ extra++; /* Escape '{' => '\{' */
nestingLevel++;
break;
case '}':
+#if COMPAT
+ braceCount++;
+#endif
+ extra++; /* Escape '}' => '\}' */
nestingLevel--;
if (nestingLevel < 0) {
- flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
+ /* Unbalanced braces! Cannot format with brace quoting. */
+ requireEscape = 1;
}
break;
+ case ']':
+ case '"':
+#if COMPAT
+ forbidNone = 1;
+ extra++; /* Escapes all just prepend a backslash */
+ preferEscape = 1;
+ break;
+#else
+ /* FLOW THROUGH */
+#endif
case '[':
case '$':
case ';':
@@ -689,32 +1002,143 @@ Tcl_ScanCountedElement(
case '\r':
case '\t':
case '\v':
- flags |= USE_BRACES;
+ forbidNone = 1;
+ extra++; /* Escape sequences all one byte longer. */
+#if COMPAT
+ preferBrace = 1;
+#endif
break;
case '\\':
- if ((p+1 == lastChar) || (p[1] == '\n')) {
- flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
- } else {
- int size;
-
- TclParseBackslash(p, lastChar - p, &size, NULL);
- p += size-1;
- flags |= USE_BRACES;
+ extra++; /* Escape '\' => '\\' */
+ if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
+ /* Final backslash. Cannot format with brace quoting. */
+ requireEscape = 1;
+ break;
+ }
+ if (p[1] == '\n') {
+ extra++; /* Escape newline => '\n', one byte longer */
+ /* Backslash newline sequence. Brace quoting not permitted. */
+ requireEscape = 1;
+ length -= (length > 0);
+ p++;
+ break;
}
+ if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
+ extra++; /* Escape sequences all one byte longer. */
+ length -= (length > 0);
+ p++;
+ }
+ forbidNone = 1;
+#if COMPAT
+ preferBrace = 1;
+#endif
+ break;
+ case '\0':
+ if (length == -1) {
+ goto endOfString;
+ }
+ /* TODO: Panic on improper encoding? */
break;
}
+ length -= (length > 0);
+ p++;
}
+
+ endOfString:
if (nestingLevel != 0) {
- flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+ /* Unbalanced braces! Cannot format with brace quoting. */
+ requireEscape = 1;
}
- *flagPtr = flags;
- /*
- * Allow enough space to backslash every character plus leave two spaces
- * for braces.
- */
+ /* We need at least as many bytes as are in the element value... */
+ bytesNeeded = p - src;
- return 2*(p-string) + 2;
+ if (requireEscape) {
+ /*
+ * We must use escape sequences. Add all the extra bytes needed
+ * to have room to create them.
+ */
+ bytesNeeded += extra;
+ /* Make room to escape leading #, if needed. */
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+ *flagPtr = CONVERT_ESCAPE;
+ goto overflowCheck;
+ }
+ if (*flagPtr & CONVERT_ANY) {
+ /*
+ * The caller has not let us know what flags it will pass to
+ * TclConvertElement() so compute the max size we might need for
+ * any possible choice. Normally the formatting using escape
+ * sequences is the longer one, and a minimum "extra" value of 2
+ * makes sure we don't request too small a buffer in those edge
+ * cases where that's not true.
+ */
+ if (extra < 2) {
+ extra = 2;
+ }
+ *flagPtr &= ~CONVERT_ANY;
+ *flagPtr |= TCL_DONT_USE_BRACES;
+ }
+ if (forbidNone) {
+ /* We must request some form of quoting of escaping... */
+#if COMPAT
+ if (preferEscape && !preferBrace) {
+ /*
+ * If we are quoting solely due to ] or internal " characters
+ * use the CONVERT_MASK mode where we escape all special
+ * characters except for braces. "extra" counted space needed
+ * to escape braces too, so substract "braceCount" to get our
+ * actual needs.
+ */
+ bytesNeeded += (extra - braceCount);
+ /* Make room to escape leading #, if needed. */
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+ /*
+ * If the caller reports it will direct TclConvertElement() to
+ * use full escapes on the element, add back the bytes needed to
+ * escape the braces.
+ */
+ if (*flagPtr & TCL_DONT_USE_BRACES) {
+ bytesNeeded += braceCount;
+ }
+ *flagPtr = CONVERT_MASK;
+ goto overflowCheck;
+ }
+#endif
+ if (*flagPtr & TCL_DONT_USE_BRACES) {
+ /*
+ * If the caller reports it will direct TclConvertElement() to
+ * use escapes, add the extra bytes needed to have room for them.
+ */
+ bytesNeeded += extra;
+ /* Make room to escape leading #, if needed. */
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ bytesNeeded++;
+ }
+ } else {
+ /* Add 2 bytes for room for the enclosing braces. */
+ bytesNeeded += 2;
+ }
+ *flagPtr = CONVERT_BRACE;
+ goto overflowCheck;
+ }
+
+ /* So far, no need to quote or escape anything. */
+ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
+ /* If we need to quote a leading #, make room to enclose in braces. */
+ bytesNeeded += 2;
+ }
+ *flagPtr = CONVERT_NONE;
+
+ overflowCheck:
+ if (bytesNeeded < 0) {
+ Tcl_Panic("TclScanElement: string length overflow");
+ }
+ return bytesNeeded;
}
/*
@@ -775,125 +1199,171 @@ Tcl_ConvertCountedElement(
char *dst, /* Place to put list-ified element. */
int flags) /* Flags produced by Tcl_ScanElement. */
{
- register char *p = dst;
- register CONST char *lastChar;
+ int numBytes = TclConvertElement(src, length, dst, flags);
+ dst[numBytes] = '\0';
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclConvertElement --
+ *
+ * This is a companion function to TclScanElement. Given the
+ * information produced by TclScanElement, this function converts
+ * a string to a list element equal to that string.
+ *
+ * Results:
+ * Information is copied to *dst in the form of a list element identical
+ * to src (i.e. if Tcl_SplitList is applied to dst it will produce a
+ * string identical to src). The return value is a count of the number of
+ * characters copied (not including the terminating NULL character).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * See the comment block at the beginning of the Tcl_ScanElement code for
- * details of how this works.
- */
+int TclConvertElement(
+ register CONST char *src, /* Source information for list element. */
+ int length, /* Number of bytes in src, or -1. */
+ char *dst, /* Place to put list-ified element. */
+ int flags) /* Flags produced by Tcl_ScanElement. */
+{
+ int conversion = flags & CONVERT_MASK;
+ char *p = dst;
- if (src && length == -1) {
- length = strlen(src);
+ /* Let the caller demand we use escape sequences rather than braces. */
+ if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
+ conversion = CONVERT_ESCAPE;
}
- if ((src == NULL) || (length == 0)) {
- p[0] = '{';
- p[1] = '}';
- p[2] = 0;
- return 2;
+
+ /* No matter what the caller demands, empty string must be braced! */
+ if ((src == NULL) || (length == 0) || ((*src == '\0') && (length == -1))) {
+ src = tclEmptyStringRep;
+ length = 0;
+ conversion = CONVERT_BRACE;
}
- lastChar = src + length;
+
+ /* Escape leading hash as needed and requested. */
if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
- flags |= USE_BRACES;
+ if (conversion == CONVERT_ESCAPE) {
+ p[0] = '\\';
+ p[1] = '#';
+ p += 2;
+ src++;
+ length--;
+ } else {
+ conversion = CONVERT_BRACE;
+ }
+ }
+
+ /* No escape or quoting needed. Copy the literal string value. */
+ if (conversion == CONVERT_NONE) {
+ if (length == -1) {
+ /* TODO: INT_MAX overflow? */
+ while (*src) {
+ *p++ = *src++;
+ }
+ return p - dst;
+ } else {
+ memcpy(dst, src, length);
+ return length;
+ }
}
- if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
+
+ /* Formatted string is original string enclosed in braces. */
+ if (conversion == CONVERT_BRACE) {
*p = '{';
p++;
- for (; src != lastChar; src++, p++) {
- *p = *src;
+ if (length == -1) {
+ /* TODO: INT_MAX overflow? */
+ while (*src) {
+ *p++ = *src++;
+ }
+ } else {
+ memcpy(p, src, length);
+ p += length;
}
*p = '}';
p++;
- } else {
- if (*src == '{') {
- /*
- * Can't have a leading brace unless the whole element is enclosed
- * in braces. Add a backslash before the brace. Furthermore, this
- * may destroy the balance between open and close braces, so set
- * BRACES_UNMATCHED.
- */
-
- p[0] = '\\';
- p[1] = '{';
- p += 2;
- src++;
- flags |= BRACES_UNMATCHED;
- } else if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
- /*
- * Leading '#' could be seen by [eval] as the start of a comment,
- * if on the first element of a list, so quote it.
- */
+ return p - dst;
+ }
- p[0] = '\\';
- p[1] = '#';
- p += 2;
- src++;
- }
- for (; src != lastChar; src++) {
- switch (*src) {
- case ']':
- case '[':
- case '$':
- case ';':
- case ' ':
- case '\\':
- case '"':
- *p = '\\';
- p++;
- break;
- case '{':
- case '}':
- /*
- * It may not seem necessary to backslash braces, but it is.
- * The reason for this is that the resulting list element may
- * actually be an element of a sub-list enclosed in braces
- * (e.g. if Tcl_DStringStartSublist has been invoked), so
- * there may be a brace mismatch if the braces aren't
- * backslashed.
- */
+ /* conversion == CONVERT_ESCAPE or CONVERT_MASK */
- if (flags & BRACES_UNMATCHED) {
- *p = '\\';
- p++;
- }
- break;
- case '\f':
- *p = '\\';
- p++;
- *p = 'f';
- p++;
- continue;
- case '\n':
- *p = '\\';
- p++;
- *p = 'n';
- p++;
- continue;
- case '\r':
- *p = '\\';
- p++;
- *p = 'r';
- p++;
- continue;
- case '\t':
- *p = '\\';
- p++;
- *p = 't';
- p++;
- continue;
- case '\v':
+ /* Formatted string is original string converted to escape sequences. */
+ for ( ; length; src++, length -= (length > 0)) {
+ switch (*src) {
+ case ']':
+ case '[':
+ case '$':
+ case ';':
+ case ' ':
+ case '\\':
+ case '"':
+ *p = '\\';
+ p++;
+ break;
+ case '{':
+ case '}':
+#if COMPAT
+ if (conversion == CONVERT_ESCAPE) {
+#endif
*p = '\\';
p++;
- *p = 'v';
- p++;
- continue;
+#if COMPAT
}
- *p = *src;
+#endif
+ break;
+ case '\f':
+ *p = '\\';
+ p++;
+ *p = 'f';
+ p++;
+ continue;
+ case '\n':
+ *p = '\\';
+ p++;
+ *p = 'n';
+ p++;
+ continue;
+ case '\r':
+ *p = '\\';
+ p++;
+ *p = 'r';
+ p++;
+ continue;
+ case '\t':
+ *p = '\\';
+ p++;
+ *p = 't';
p++;
+ continue;
+ case '\v':
+ *p = '\\';
+ p++;
+ *p = 'v';
+ p++;
+ continue;
+ case '\0':
+ if (length == -1) {
+ return p - dst;
+ }
+ /*
+ * If we reach this point, there's an embedded NULL in the
+ * string range being processed, which should not happen when
+ * the encoding rules for Tcl strings are properly followed.
+ * If the day ever comes when we stop tolerating such things,
+ * this is where to put the Tcl_Panic().
+ */
+ break;
}
+ *p = *src;
+ p++;
}
- *p = '\0';
- return p-dst;
+ return p - dst;
}
/*
@@ -922,11 +1392,20 @@ Tcl_Merge(
CONST char * CONST *argv) /* Array of string values. */
{
# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr;
- int numChars;
- char *result;
- char *dst;
- int i;
+ int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+ int i, bytesNeeded = 0;
+ char *result, *dst;
+ const int maxFlags = UINT_MAX / sizeof(int);
+
+ if (argc == 0) {
+ /*
+ * Handle empty list case first, so logic of the general case
+ * can be simpler.
+ */
+ result = ckalloc(1);
+ result[0] = '\0';
+ return result;
+ }
/*
* Pass 1: estimate space, gather flags.
@@ -934,32 +1413,48 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
+ } else if (argc > maxFlags) {
+ /*
+ * We cannot allocate a large enough flag array to format this
+ * list in one pass. We could imagine converting this routine
+ * to a multi-pass implementation, but for sizeof(int) == 4,
+ * the limit is a max of 2^30 list elements and since each element
+ * is at least one byte formatted, and requires one byte space
+ * between it and the next one, that a minimum space requirement
+ * of 2^31 bytes, which is already INT_MAX. If we tried to format
+ * a list of > maxFlags elements, we're just going to overflow
+ * the size limits on the formatted string anyway, so just issue
+ * that same panic early.
+ */
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
}
- numChars = 1;
for (i = 0; i < argc; i++) {
- numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
+ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
+ if (bytesNeeded < 0) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
}
+ if (bytesNeeded > INT_MAX - argc + 1) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+ bytesNeeded += argc;
/*
* Pass two: copy into the result area.
*/
- result = (char *) ckalloc((unsigned) numChars);
+ result = ckalloc((unsigned) bytesNeeded);
dst = result;
for (i = 0; i < argc; i++) {
- numChars = Tcl_ConvertElement(argv[i], dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
- dst += numChars;
+ flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+ dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
*dst = ' ';
dst++;
}
- if (dst == result) {
- *dst = 0;
- } else {
- dst[-1] = 0;
- }
+ dst[-1] = 0;
if (flagPtr != localFlags) {
ckfree((char *) flagPtr);
@@ -1972,12 +2467,11 @@ Tcl_DStringAppendElement(
CONST char *element) /* String to append. Must be
* null-terminated. */
{
- int newSize, flags, strSize;
- char *dst;
-
- strSize = ((element== NULL) ? 0 : strlen(element));
- newSize = Tcl_ScanCountedElement(element, strSize, &flags)
- + dsPtr->length + 1;
+ char *dst = dsPtr->string + dsPtr->length;
+ int needSpace = TclNeedSpace(dsPtr->string, dst);
+ int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
+ int newSize = dsPtr->length + needSpace
+ + TclScanElement(element, -1, &flags);
/*
* Allocate a larger buffer for the string if the current one isn't large
@@ -1998,6 +2492,7 @@ Tcl_DStringAppendElement(
dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
(size_t) dsPtr->spaceAvl);
}
+ dst = dsPtr->string + dsPtr->length;
}
/*
@@ -2005,8 +2500,7 @@ Tcl_DStringAppendElement(
* the end, with a space, if needed.
*/
- dst = dsPtr->string + dsPtr->length;
- if (TclNeedSpace(dsPtr->string, dst)) {
+ if (needSpace) {
*dst = ' ';
dst++;
dsPtr->length++;
@@ -2019,7 +2513,8 @@ Tcl_DStringAppendElement(
flags |= TCL_DONT_QUOTE_HASH;
}
- dsPtr->length += Tcl_ConvertCountedElement(element, strSize, dst, flags);
+ dsPtr->length += TclConvertElement(element, -1, dst, flags);
+ dsPtr->string[dsPtr->length] = '\0';
return dsPtr->string;
}
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 87af637..aaef2b8 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.7.5
+package provide http 2.7.6
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -900,7 +900,6 @@ proc http::Write {token} {
incr state(queryoffset) $state(-queryblocksize)
if {$state(queryoffset) >= $state(querylength)} {
set state(queryoffset) $state(querylength)
- puts $sock ""
set done 1
}
} else {
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 1eec2b6..fed5829 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
# Tcl package index file, version 1.1
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.5 [list tclPkgSetup $dir http 2.7.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.6 [list tclPkgSetup $dir http 2.7.6 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 231eaa1..369ed52 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -13,7 +13,7 @@
package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.4.3
+package provide msgcat 1.4.4
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
@@ -175,7 +175,7 @@ namespace eval msgcat {
# args Args to pass to the format command
#
# Results:
-# Returns the translated string. Propagates errors thrown by the
+# Returns the translated string. Propagates errors thrown by the
# format command.
proc msgcat::mc {src args} {
@@ -187,7 +187,7 @@ proc msgcat::mc {src args} {
variable Locale
set ns [uplevel 1 [list ::namespace current]]
-
+
while {$ns != ""} {
foreach loc $Loclist {
if {[dict exists $Msgs $loc $ns $src]} {
@@ -310,16 +310,9 @@ proc msgcat::mcset {locale src {dest ""}} {
}
set ns [uplevel 1 [list ::namespace current]]
-
+
set locale [string tolower $locale]
-
- # create nested dictionaries if they do not exist
- if {![dict exists $Msgs $locale]} {
- dict set Msgs $locale [dict create]
- }
- if {![dict exists $Msgs $locale $ns]} {
- dict set Msgs $locale $ns [dict create]
- }
+
dict set Msgs $locale $ns $src $dest
return $dest
}
@@ -343,17 +336,10 @@ proc msgcat::mcmset {locale pairs } {
return -code error "bad translation list:\
should be \"[lindex [info level 0] 0] locale {src dest ...}\""
}
-
+
set locale [string tolower $locale]
set ns [uplevel 1 [list ::namespace current]]
- # create nested dictionaries if they do not exist
- if {![dict exists $Msgs $locale]} {
- dict set Msgs $locale [dict create]
- }
- if {![dict exists $Msgs $locale $ns]} {
- dict set Msgs $locale $ns [dict create]
- }
foreach {src dest} $pairs {
dict set Msgs $locale $ns $src $dest
}
@@ -366,7 +352,7 @@ proc msgcat::mcmset {locale pairs } {
# This routine is called by msgcat::mc if a translation cannot
# be found for a string. This routine is intended to be replaced
# by an application specific routine for error reporting
-# purposes. The default behavior is to return the source string.
+# purposes. The default behavior is to return the source string.
# If additional args are specified, the format command will be used
# to work them into the traslated string.
#
@@ -388,7 +374,7 @@ proc msgcat::mcunknown {locale src args} {
# msgcat::mcmax --
#
-# Calculates the maximum length of the translated strings of the given
+# Calculates the maximum length of the translated strings of the given
# list.
#
# Arguments:
@@ -474,14 +460,14 @@ proc msgcat::Init {} {
}
#
# On Windows, try to set locale depending on registry settings,
- # or fall back on locale of "C".
+ # or fall back on locale of "C".
#
- set key {HKEY_CURRENT_USER\Control Panel\International}
if {[catch {
package require registry
+ set key {HKEY_CURRENT_USER\Control Panel\International}
set locale [registry get $key "locale"]
}]} {
- mclocale C
+ mclocale C
return
}
#
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 63ed8ed..17ad5db 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.4.3 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.4.4 [list source [file join $dir msgcat.tcl]]
diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo
index 10d7193..165d8c4 100644
--- a/library/tzdata/Africa/Cairo
+++ b/library/tzdata/Africa/Cairo
@@ -125,182 +125,4 @@ set TZData(:Africa/Cairo) {
{1281474000 7200 0 EET}
{1284069600 10800 1 EEST}
{1285880400 7200 0 EET}
- {1304028000 10800 1 EEST}
- {1317330000 7200 0 EET}
- {1335477600 10800 1 EEST}
- {1348779600 7200 0 EET}
- {1366927200 10800 1 EEST}
- {1380229200 7200 0 EET}
- {1398376800 10800 1 EEST}
- {1411678800 7200 0 EET}
- {1429826400 10800 1 EEST}
- {1443128400 7200 0 EET}
- {1461880800 10800 1 EEST}
- {1475182800 7200 0 EET}
- {1493330400 10800 1 EEST}
- {1506632400 7200 0 EET}
- {1524780000 10800 1 EEST}
- {1538082000 7200 0 EET}
- {1556229600 10800 1 EEST}
- {1569531600 7200 0 EET}
- {1587679200 10800 1 EEST}
- {1600981200 7200 0 EET}
- {1619733600 10800 1 EEST}
- {1633035600 7200 0 EET}
- {1651183200 10800 1 EEST}
- {1664485200 7200 0 EET}
- {1682632800 10800 1 EEST}
- {1695934800 7200 0 EET}
- {1714082400 10800 1 EEST}
- {1727384400 7200 0 EET}
- {1745532000 10800 1 EEST}
- {1758834000 7200 0 EET}
- {1776981600 10800 1 EEST}
- {1790283600 7200 0 EET}
- {1809036000 10800 1 EEST}
- {1822338000 7200 0 EET}
- {1840485600 10800 1 EEST}
- {1853787600 7200 0 EET}
- {1871935200 10800 1 EEST}
- {1885237200 7200 0 EET}
- {1903384800 10800 1 EEST}
- {1916686800 7200 0 EET}
- {1934834400 10800 1 EEST}
- {1948136400 7200 0 EET}
- {1966888800 10800 1 EEST}
- {1980190800 7200 0 EET}
- {1998338400 10800 1 EEST}
- {2011640400 7200 0 EET}
- {2029788000 10800 1 EEST}
- {2043090000 7200 0 EET}
- {2061237600 10800 1 EEST}
- {2074539600 7200 0 EET}
- {2092687200 10800 1 EEST}
- {2105989200 7200 0 EET}
- {2124136800 10800 1 EEST}
- {2137438800 7200 0 EET}
- {2156191200 10800 1 EEST}
- {2169493200 7200 0 EET}
- {2187640800 10800 1 EEST}
- {2200942800 7200 0 EET}
- {2219090400 10800 1 EEST}
- {2232392400 7200 0 EET}
- {2250540000 10800 1 EEST}
- {2263842000 7200 0 EET}
- {2281989600 10800 1 EEST}
- {2295291600 7200 0 EET}
- {2313439200 10800 1 EEST}
- {2326741200 7200 0 EET}
- {2345493600 10800 1 EEST}
- {2358795600 7200 0 EET}
- {2376943200 10800 1 EEST}
- {2390245200 7200 0 EET}
- {2408392800 10800 1 EEST}
- {2421694800 7200 0 EET}
- {2439842400 10800 1 EEST}
- {2453144400 7200 0 EET}
- {2471292000 10800 1 EEST}
- {2484594000 7200 0 EET}
- {2503346400 10800 1 EEST}
- {2516648400 7200 0 EET}
- {2534796000 10800 1 EEST}
- {2548098000 7200 0 EET}
- {2566245600 10800 1 EEST}
- {2579547600 7200 0 EET}
- {2597695200 10800 1 EEST}
- {2610997200 7200 0 EET}
- {2629144800 10800 1 EEST}
- {2642446800 7200 0 EET}
- {2660594400 10800 1 EEST}
- {2673896400 7200 0 EET}
- {2692648800 10800 1 EEST}
- {2705950800 7200 0 EET}
- {2724098400 10800 1 EEST}
- {2737400400 7200 0 EET}
- {2755548000 10800 1 EEST}
- {2768850000 7200 0 EET}
- {2786997600 10800 1 EEST}
- {2800299600 7200 0 EET}
- {2818447200 10800 1 EEST}
- {2831749200 7200 0 EET}
- {2850501600 10800 1 EEST}
- {2863803600 7200 0 EET}
- {2881951200 10800 1 EEST}
- {2895253200 7200 0 EET}
- {2913400800 10800 1 EEST}
- {2926702800 7200 0 EET}
- {2944850400 10800 1 EEST}
- {2958152400 7200 0 EET}
- {2976300000 10800 1 EEST}
- {2989602000 7200 0 EET}
- {3007749600 10800 1 EEST}
- {3021051600 7200 0 EET}
- {3039804000 10800 1 EEST}
- {3053106000 7200 0 EET}
- {3071253600 10800 1 EEST}
- {3084555600 7200 0 EET}
- {3102703200 10800 1 EEST}
- {3116005200 7200 0 EET}
- {3134152800 10800 1 EEST}
- {3147454800 7200 0 EET}
- {3165602400 10800 1 EEST}
- {3178904400 7200 0 EET}
- {3197052000 10800 1 EEST}
- {3210354000 7200 0 EET}
- {3229106400 10800 1 EEST}
- {3242408400 7200 0 EET}
- {3260556000 10800 1 EEST}
- {3273858000 7200 0 EET}
- {3292005600 10800 1 EEST}
- {3305307600 7200 0 EET}
- {3323455200 10800 1 EEST}
- {3336757200 7200 0 EET}
- {3354904800 10800 1 EEST}
- {3368206800 7200 0 EET}
- {3386959200 10800 1 EEST}
- {3400261200 7200 0 EET}
- {3418408800 10800 1 EEST}
- {3431710800 7200 0 EET}
- {3449858400 10800 1 EEST}
- {3463160400 7200 0 EET}
- {3481308000 10800 1 EEST}
- {3494610000 7200 0 EET}
- {3512757600 10800 1 EEST}
- {3526059600 7200 0 EET}
- {3544207200 10800 1 EEST}
- {3557509200 7200 0 EET}
- {3576261600 10800 1 EEST}
- {3589563600 7200 0 EET}
- {3607711200 10800 1 EEST}
- {3621013200 7200 0 EET}
- {3639160800 10800 1 EEST}
- {3652462800 7200 0 EET}
- {3670610400 10800 1 EEST}
- {3683912400 7200 0 EET}
- {3702060000 10800 1 EEST}
- {3715362000 7200 0 EET}
- {3734114400 10800 1 EEST}
- {3747416400 7200 0 EET}
- {3765564000 10800 1 EEST}
- {3778866000 7200 0 EET}
- {3797013600 10800 1 EEST}
- {3810315600 7200 0 EET}
- {3828463200 10800 1 EEST}
- {3841765200 7200 0 EET}
- {3859912800 10800 1 EEST}
- {3873214800 7200 0 EET}
- {3891362400 10800 1 EEST}
- {3904664400 7200 0 EET}
- {3923416800 10800 1 EEST}
- {3936718800 7200 0 EET}
- {3954866400 10800 1 EEST}
- {3968168400 7200 0 EET}
- {3986316000 10800 1 EEST}
- {3999618000 7200 0 EET}
- {4017765600 10800 1 EEST}
- {4031067600 7200 0 EET}
- {4049215200 10800 1 EEST}
- {4062517200 7200 0 EET}
- {4080664800 10800 1 EEST}
- {4093966800 7200 0 EET}
}
diff --git a/tests/list.test b/tests/list.test
index aab165c..5a002a9 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -105,6 +105,10 @@ test list-3.1 {SetListFromAny and lrange/concat results} {
slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}
+test list-4.1 {Bug 3173086} {
+ string is list "{[list \\\\\}]}"
+} 1
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 782a89b..96d5062 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -771,15 +771,15 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
- @echo "Installing package http 2.7.5 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.5.tm;
+ @echo "Installing package http 2.7.6 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.6.tm;
@echo "Installing library opt0.4 directory";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
- @echo "Installing package msgcat 1.4.3 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.3.tm;
+ @echo "Installing package msgcat 1.4.4 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
@echo "Installing package tcltest 2.3.2 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm;
diff --git a/win/Makefile.in b/win/Makefile.in
index bb71186..97a7e7b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -638,15 +638,15 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.7.5 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.5.tm;
+ @echo "Installing package http 2.7.6 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.6.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.4.3 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.3.tm;
+ @echo "Installing package msgcat 1.4.4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
@echo "Installing package tcltest 2.3.2 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.2.tm;
@echo "Installing package platform 1.0.9 as a Tcl Module";
diff --git a/win/configure b/win/configure
index c397e45..288e57d 100755
--- a/win/configure
+++ b/win/configure
@@ -4201,6 +4201,64 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
;;
+ *)
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+ #ifdef _WIN64
+ #error 64-bit
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_win_64bit=no
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_win_64bit=yes
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test "$tcl_win_64bit" = "yes" ; then
+ do64bit=amd64
+ MACHINE="AMD64"
+ echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
+echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ fi
+ ;;
esac
else
if test "${SHARED_BUILD}" = "0" ; then
diff --git a/win/tcl.m4 b/win/tcl.m4
index be22fac..83a4ea3 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -557,6 +557,21 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
MACHINE="IA64"
AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
;;
+ *)
+ AC_TRY_COMPILE([
+ #ifdef _WIN64
+ #error 64-bit
+ #endif
+ ], [],
+ tcl_win_64bit=no,
+ tcl_win_64bit=yes
+ )
+ if test "$tcl_win_64bit" = "yes" ; then
+ do64bit=amd64
+ MACHINE="AMD64"
+ AC_MSG_RESULT([ Using 64-bit $MACHINE mode])
+ fi
+ ;;
esac
else
if test "${SHARED_BUILD}" = "0" ; then
generated by cgit v0.12 at 2024-11-19 18:50:14 (GMT)