summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-12-20 09:30:02 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-12-20 09:30:02 (GMT)
commit1c8b2b280f3d85688ac53e997df447281672a44a (patch)
treed84b517e050859f5635eef156f6869f152c3de2a /generic
parentb8271467dc712230e7eecf2818f7232c2ebda8b4 (diff)
parent43b22f924faa4963e0238f2191f56270c8d90b81 (diff)
downloadtcl-1c8b2b280f3d85688ac53e997df447281672a44a.zip
tcl-1c8b2b280f3d85688ac53e997df447281672a44a.tar.gz
tcl-1c8b2b280f3d85688ac53e997df447281672a44a.tar.bz2
merge trunk (still has test failure in socket.test)
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclBasic.c22
-rw-r--r--generic/tclBinary.c174
-rw-r--r--generic/tclClock.c5
-rw-r--r--generic/tclEncoding.c8
-rw-r--r--generic/tclIO.c2
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclInterp.c1
-rw-r--r--generic/tclStringObj.c44
-rw-r--r--generic/tclStringRep.h10
-rw-r--r--generic/tclTest.c42
-rw-r--r--generic/tclVar.c2
12 files changed, 238 insertions, 79 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 7cdcbb6..895245e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1320,9 +1320,9 @@ typedef struct Tcl_HashSearch {
* TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the
* pointer is stored in the entry.
*
- * While maintaining binary compatability the above have to be distinct values
+ * While maintaining binary compatibility the above have to be distinct values
* as they are used to differentiate between old versions of the hash table
- * which don't have a typePtr and new ones which do. Once binary compatability
+ * which don't have a typePtr and new ones which do. Once binary compatibility
* is discarded in favour of making more wide spread changes TCL_STRING_KEYS
* can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
* same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c1dd52d..81b3513 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3024,13 +3024,6 @@ Tcl_DeleteCommandFromToken(
Tcl_Command importCmd;
/*
- * Bump the command epoch counter. This will invalidate all cached
- * references that point to this command.
- */
-
- cmdPtr->cmdEpoch++;
-
- /*
* The code here is tricky. We can't delete the hash table entry before
* invoking the deletion callback because there are cases where the
* deletion callback needs to invoke the command (e.g. object systems such
@@ -3052,6 +3045,14 @@ Tcl_DeleteCommandFromToken(
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
}
+
+ /*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
+
return 0;
}
@@ -3154,6 +3155,13 @@ Tcl_DeleteCommandFromToken(
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
+
+ /*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
}
/*
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 9a5771e..4d063b2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -155,35 +155,108 @@ static const EnsembleImplMap decodeMap[] = {
};
/*
- * The following object type represents an array of bytes. An array of bytes
- * is not equivalent to an internationalized string. Conceptually, a string is
- * an array of 16-bit quantities organized as a sequence of properly formed
- * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
- * Accessor functions are provided to convert a ByteArray to a String or a
- * String to a ByteArray. Two or more consecutive bytes in an array of bytes
- * may look like a single UTF-8 character if the array is casually treated as
- * a string. But obtaining the String from a ByteArray is guaranteed to
- * produced properly formed UTF-8 sequences so that there is a one-to-one map
- * between bytes and characters.
- *
- * Converting a ByteArray to a String proceeds by casting each byte in the
- * array to a 16-bit quantity, treating that number as a Unicode character,
- * and storing the UTF-8 version of that Unicode character in the String. For
- * ByteArrays consisting entirely of values 1..127, the corresponding String
- * representation is the same as the ByteArray representation.
- *
- * Converting a String to a ByteArray proceeds by getting the Unicode
- * representation of each character in the String, casting it to a byte by
- * truncating the upper 8 bits, and then storing the byte in the ByteArray.
- * Converting from ByteArray to String and back to ByteArray is not lossy, but
- * converting an arbitrary String to a ByteArray may be.
+ * The following object types represent an array of bytes. The intent is
+ * to allow arbitrary binary data to pass through Tcl as a Tcl value
+ * without loss or damage. Such values are useful for things like
+ * encoded strings or Tk images to name just two.
+ *
+ * It's strange to have two Tcl_ObjTypes in place for this task when
+ * one would do, so a bit of detail and history how we got to this point
+ * and where we might go from here.
+ *
+ * A bytearray is an ordered sequence of bytes. Each byte is an integer
+ * value in the range [0-255]. To be a Tcl value type, we need a way to
+ * encode each value in the value set as a Tcl string. The simplest
+ * encoding is to represent each byte value as the same codepoint value.
+ * A bytearray of N bytes is encoded into a Tcl string of N characters
+ * where the codepoint of each character is the value of corresponding byte.
+ * This approach creates a one-to-one map between all bytearray values
+ * and a subset of Tcl string values.
+ *
+ * When converting a Tcl string value to the bytearray internal rep, the
+ * question arises what to do with strings outside that subset? That is,
+ * those Tcl strings containing at least one codepoint greater than 255?
+ * The obviously correct answer is to raise an error! That string value
+ * does not represent any valid bytearray value. Full Stop. The
+ * setFromAnyProc signature has a completion code return value for just
+ * this reason, to reject invalid inputs.
+ *
+ * Unfortunately this was not the path taken by the authors of the
+ * original tclByteArrayType. They chose to accept all Tcl string values
+ * as acceptable string encodings of the bytearray values that result
+ * from masking away the high bits of any codepoint value at all. This
+ * meant that every bytearray value had multiple accepted string
+ * representations.
+ *
+ * The implications of this choice are truly ugly. When a Tcl value has
+ * a string representation, we are required to accept that as the true
+ * value. Bytearray values that possess a string representation cannot
+ * be processed as bytearrays because we cannot know which true value
+ * that bytearray represents. The consequence is that we drag around
+ * an internal rep that we cannot make any use of. This painful price
+ * is extracted at any point after a string rep happens to be generated
+ * for the value. This happens even when the troublesome codepoints
+ * outside the byte range never show up. This happens rather routinely
+ * in normal Tcl operations unless we burden the script writer with the
+ * cognitive burden of avoiding it. The price is also paid by callers
+ * of the C interface. The routine
+ *
+ * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
+ *
+ * has a guarantee to always return a non-NULL value, but that value
+ * points to a byte sequence that cannot be used by the caller to
+ * process the Tcl value absent some sideband testing that objPtr
+ * is "pure". Tcl offers no public interface to perform this test,
+ * so callers either break encapsulation or are unavoidably buggy. Tcl
+ * has defined a public interface that cannot be used correctly. The
+ * Tcl source code itself suffers the same problem, and has been buggy,
+ * but progressively less so as more and more portions of the code have
+ * been retrofitted with the required "purity testing". The set of values
+ * able to pass the purity test can be increased via the introduction of
+ * a "canonical" flag marker, but the only way the broken interface itself
+ * can be discarded is to start over and define the Tcl_ObjType properly.
+ * Bytearrays should simply be usable as bytearrays without a kabuki
+ * dance of testing.
+ *
+ * The Tcl_ObjType "properByteArrayType" is (nearly) a correct
+ * implementation of bytearrays. Any Tcl value with the type
+ * properByteArrayType can have its bytearray value fetched and
+ * used with confidence that acting on that value is equivalent to
+ * acting on the true Tcl string value. This still implies a side
+ * testing burden -- past mistakes will not let us avoid that
+ * immediately, but it is at least a conventional test of type, and
+ * can be implemented entirely by examining the objPtr fields, with
+ * no need to query the intrep, as a canonical flag would require.
+ *
+ * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can
+ * be revised to admit the possibility of returning NULL when the true
+ * value is not a valid bytearray, we need a mechanism to retain
+ * compatibility with the deployed callers of the broken interface.
+ * That's what the retained "tclByteArrayType" provides. In those
+ * unusual circumstances where we convert an invalid bytearray value
+ * to a bytearray type, it is to this legacy type. Essentially any
+ * time this legacy type gets used, it's a signal of a bug being ignored.
+ * A TIP should be drafted to remove this connection to the broken past
+ * so that Tcl 9 will no longer have any trace of it. Prescribing a
+ * migration path will be the key element of that work. The internal
+ * changes now in place are the limit of what can be done short of
+ * interface repair. They provide a great expansion of the histories
+ * over which bytearray values can be useful in the meanwhile.
*/
-const Tcl_ObjType tclByteArrayType = {
+static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
UpdateStringOfByteArray,
+ NULL
+};
+
+const Tcl_ObjType tclByteArrayType = {
+ "bytearray",
+ FreeByteArrayInternalRep,
+ DupByteArrayInternalRep,
+ NULL,
SetByteArrayFromAny
};
@@ -211,6 +284,12 @@ typedef struct ByteArray {
#define SET_BYTEARRAY(objPtr, baPtr) \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+int
+TclIsPureByteArray(
+ Tcl_Obj * objPtr)
+{
+ return (objPtr->typePtr == &properByteArrayType);
+}
/*
*----------------------------------------------------------------------
@@ -341,7 +420,7 @@ Tcl_SetByteArrayObj(
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
}
- objPtr->typePtr = &tclByteArrayType;
+ objPtr->typePtr = &properByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
@@ -371,7 +450,8 @@ Tcl_GetByteArrayFromObj(
{
ByteArray *baPtr;
- if (objPtr->typePtr != &tclByteArrayType) {
+ if ((objPtr->typePtr != &properByteArrayType)
+ && (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
baPtr = GET_BYTEARRAY(objPtr);
@@ -414,7 +494,8 @@ Tcl_SetByteArrayLength(
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
- if (objPtr->typePtr != &tclByteArrayType) {
+ if ((objPtr->typePtr != &properByteArrayType)
+ && (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
@@ -450,29 +531,35 @@ SetByteArrayFromAny(
Tcl_Interp *interp, /* Not used. */
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
- int length;
+ int length, improper = 0;
const char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
- if (objPtr->typePtr != &tclByteArrayType) {
- src = TclGetStringFromObj(objPtr, &length);
- srcEnd = src + length;
-
- byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
- for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
- src += Tcl_UtfToUniChar(src, &ch);
- *dst++ = UCHAR(ch);
- }
+ if (objPtr->typePtr == &properByteArrayType) {
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclByteArrayType) {
+ return TCL_OK;
+ }
- byteArrayPtr->used = dst - byteArrayPtr->bytes;
- byteArrayPtr->allocated = length;
+ src = TclGetStringFromObj(objPtr, &length);
+ srcEnd = src + length;
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &tclByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ improper = improper || (ch > 255);
+ *dst++ = UCHAR(ch);
}
+
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
+ byteArrayPtr->allocated = length;
+
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
return TCL_OK;
}
@@ -535,7 +622,7 @@ DupByteArrayInternalRep(
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
- copyPtr->typePtr = &tclByteArrayType;
+ copyPtr->typePtr = srcPtr->typePtr;
}
/*
@@ -642,7 +729,8 @@ TclAppendBytesToByteArray(
/* Append zero bytes is a no-op. */
return;
}
- if (objPtr->typePtr != &tclByteArrayType) {
+ if ((objPtr->typePtr != &properByteArrayType)
+ && (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
diff --git a/generic/tclClock.c b/generic/tclClock.c
index c3b29e9..27009fd 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -92,7 +92,7 @@ static const char *const literals[] = {
*/
typedef struct ClockClientData {
- int refCount; /* Number of live references. */
+ size_t refCount; /* Number of live references. */
Tcl_Obj **literals; /* Pool of object literals. */
} ClockClientData;
@@ -2060,8 +2060,7 @@ ClockDeleteCmdProc(
ClockClientData *data = clientData;
int i;
- data->refCount--;
- if (data->refCount == 0) {
+ if (data->refCount-- <= 1) {
for (i = 0; i < LIT__END; ++i) {
Tcl_DecrRefCount(data->literals[i]);
}
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 8a4dc3b..91c2278 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -46,7 +46,7 @@ typedef struct Encoding {
* nullSize is 2, this is a function that
* returns the number of bytes in a 0x0000
* terminated string. */
- int refCount; /* Number of uses of this structure. */
+ size_t refCount; /* Number of uses of this structure. */
Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
} Encoding;
@@ -844,11 +844,7 @@ FreeEncoding(
if (encodingPtr == NULL) {
return;
}
- if (encodingPtr->refCount<=0) {
- Tcl_Panic("FreeEncoding: refcount problem !!!");
- }
- encodingPtr->refCount--;
- if (encodingPtr->refCount == 0) {
+ if (encodingPtr->refCount-- <= 1) {
if (encodingPtr->freeProc != NULL) {
encodingPtr->freeProc(encodingPtr->clientData);
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 80f6fa4..ffd2430 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -7129,7 +7129,7 @@ Tcl_Tell(
*
* Tcl_SeekOld, Tcl_TellOld --
*
- * Backward-compatability versions of the seek/tell interface that do not
+ * Backward-compatibility versions of the seek/tell interface that do not
* support 64-bit offsets. This interface is not documented or expected
* to be supported indefinitely.
*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8f85f19..ca8ad70 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4427,8 +4427,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*----------------------------------------------------------------
*/
-#define TclIsPureByteArray(objPtr) \
- (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1bfe76a..6983cc6 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -410,6 +410,7 @@ Tcl_Init(
" {file join $grandParentDir lib tcl[info tclversion]} \\\n"
" {file join $parentDir library} \\\n"
" {file join $grandParentDir library} \\\n"
+" {file join $grandParentDir tcl[info tclversion] library} \\\n"
" {file join $grandParentDir tcl[info patchlevel] library} \\\n"
" {\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 6184461..db233b3 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1865,6 +1865,14 @@ Tcl_AppendFormatToObj(
useWide = 1;
#endif
}
+ } else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) {
+ format += (step + 2);
+ step = Tcl_UtfToUniChar(format, &ch);
+ useBig = 1;
+ } else if (ch == 'L') {
+ format += step;
+ step = Tcl_UtfToUniChar(format, &ch);
+ useBig = 1;
}
format += step;
@@ -2472,6 +2480,10 @@ AppendPrintfToObjVA(
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
va_arg(argList, long)));
break;
+ case 2:
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+ va_arg(argList, Tcl_WideInt)));
+ break;
}
break;
case 'e':
@@ -2500,9 +2512,20 @@ AppendPrintfToObjVA(
gotPrecision = 1;
p++;
break;
- /* TODO: support for wide (and bignum?) arguments */
+ /* TODO: support for bignum arguments */
case 'l':
- size = 1;
+ ++size;
+ p++;
+ break;
+ case 'L':
+ size = 2;
+ p++;
+ break;
+ case 'I':
+ if (p[1]=='6' && p[2]=='4') {
+ p += 2;
+ size = 2;
+ }
p++;
break;
case 'h':
@@ -2708,8 +2731,9 @@ TclStringRepeat(
if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "string size overflow: unable to alloc %lu bytes",
- STRING_SIZE(count*length)));
+ "string size overflow: unable to alloc %"
+ TCL_LL_MODIFIER "u bytes",
+ (Tcl_WideUInt)STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
@@ -2895,7 +2919,7 @@ TclStringCatObjv(
* Broken interface! Byte array value routines offer no way
* to handle failure to allocate enough space. Following
* stanza may panic.
- */
+ */
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
@@ -2931,8 +2955,9 @@ TclStringCatObjv(
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "concatenation failed: unable to alloc %lu bytes",
- STRING_SIZE(length)));
+ "concatenation failed: unable to alloc %"
+ TCL_LL_MODIFIER "u bytes",
+ (Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
@@ -2946,8 +2971,9 @@ TclStringCatObjv(
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "concatenation failed: unable to alloc %lu bytes",
- STRING_SIZE(length)));
+ "concatenation failed: unable to alloc %"
+ TCL_LL_MODIFIER "u bytes",
+ (Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index db6f7e4..1ef1957 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -72,17 +72,17 @@ typedef struct {
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
- STRING_MAXCHARS); \
+ (int)STRING_MAXCHARS); \
} \
} while (0)
#define stringAttemptAlloc(numChars) \
- (String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
+ (String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
- (String *) ckalloc((unsigned) STRING_SIZE(numChars))
+ (String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
- (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+ (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
- (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+ (String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e30c4d0..dee1fe7 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -318,6 +318,9 @@ static int TestparsevarnameObjCmd(ClientData dummy,
static int TestpreferstableObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int TestprintObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int TestregexpObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -649,6 +652,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -3820,6 +3825,43 @@ TestpreferstableObjCmd(
/*
*----------------------------------------------------------------------
*
+ * TestprintObjCmd --
+ *
+ * This procedure implements the "testprint" command. It is
+ * used for being able to test the Tcl_ObjPrintf() function.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestprintObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ Tcl_WideInt argv1 = 0;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
+ }
+
+ if (objc > 1) {
+ Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestregexpObjCmd --
*
* This procedure implements the "testregexp" command. It is used to give
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 48e09f6..5ab6e8b 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2754,7 +2754,7 @@ TclArraySet(
} else {
/*
* Not a dictionary, so assume (and convert to, for backward-
- * -compatability reasons) a list.
+ * -compatibility reasons) a list.
*/
int elemLen;