merge trunk

4 files changed, 67 insertions, 47 deletions

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 210d63e..4a230f5 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -179,11 +179,19 @@ static const EnsembleImplMap decodeMap[] = {
  * converting an arbitrary String to a ByteArray may be.
  */
 
-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 +219,12 @@ typedef struct {
 #define SET_BYTEARRAY(objPtr, baPtr) \
 		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
 
+int
+TclIsPureByteArray(
+    Tcl_Obj * objPtr)
+{
+    return (objPtr->typePtr == &properByteArrayType);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -341,7 +355,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 +385,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 +429,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 +466,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 +557,7 @@ DupByteArrayInternalRep(
     memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
     SET_BYTEARRAY(copyPtr, copyArrayPtr);
 
-    copyPtr->typePtr = &tclByteArrayType;
+    copyPtr->typePtr = srcPtr->typePtr;
 }
 
 /*
@@ -642,7 +664,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/tclDisassemble.c b/generic/tclDisassemble.c
index 0b1a4ad..64306f3 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -254,7 +254,7 @@ DisassembleByteCodeObj(
     int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
     Tcl_Obj *bufferObj, *fileObj;
-    char buf[128];
+    char ptrBuf1[20], ptrBuf2[20];
 
     TclNewObj(bufferObj);
     if (codePtr->refCount <= 0) {
@@ -269,12 +269,12 @@ DisassembleByteCodeObj(
      * Print header lines describing the ByteCode.
      */
 
-    sprintf(buf,
-	    "%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, "
-	    "interp 0x%p (epoch %" TCL_LL_MODIFIER "u",
-	    codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr,
-	    (Tcl_WideInt)iPtr->compileEpoch);
-    Tcl_AppendPrintfToObj(bufferObj, "ByteCode 0x%s)\n", buf);
+    sprintf(ptrBuf1, "%p", codePtr);
+    sprintf(ptrBuf2, "%p", iPtr);
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "ByteCode 0x%s, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%s (epoch %" TCL_LL_MODIFIER "u)\n",
+	    ptrBuf1, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, ptrBuf2,
+	    (Tcl_WideUInt)iPtr->compileEpoch);
     Tcl_AppendToObj(bufferObj, "  Source ", -1);
     PrintSourceToObj(bufferObj, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
@@ -316,10 +316,10 @@ DisassembleByteCodeObj(
 	Proc *procPtr = codePtr->procPtr;
 	int numCompiledLocals = procPtr->numCompiledLocals;
 
-	sprintf(buf, "%p, refCt %" TCL_LL_MODIFIER "u", procPtr, (Tcl_WideInt) procPtr->refCount);
+	sprintf(ptrBuf1, "%p", procPtr);
 	Tcl_AppendPrintfToObj(bufferObj,
-		"  Proc 0x%s, args %d, compiled locals %d\n",
-		buf, procPtr->numArgs,
+		"  Proc 0x%s, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n",
+		ptrBuf1, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs,
 		numCompiledLocals);
 	if (numCompiledLocals > 0) {
 	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0f286a5..b36f004 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4369,8 +4369,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/tclStringObj.c b/generic/tclStringObj.c
index 6be782c..f9c1ebd 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2473,6 +2473,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':
@@ -2501,9 +2505,9 @@ 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 'h':
@@ -2708,11 +2712,9 @@ TclStringRepeat(
 
         if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
 	    if (interp) {
-		char buf[TCL_INTEGER_SPACE];
-		sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(count*length));
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"string size overflow: unable to alloc %s bytes",
-			buf));
+			"string size overflow: unable to alloc %llu bytes",
+			(Tcl_WideUInt)STRING_SIZE(count*length)));
 		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	    }
 	    return TCL_ERROR;
@@ -2933,11 +2935,9 @@ TclStringCatObjv(
 	    Tcl_InvalidateStringRep(objResultPtr);
 	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
 		if (interp) {
-		    char buf[TCL_INTEGER_SPACE];
-		    sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length));
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    	"concatenation failed: unable to alloc %s bytes",
-			buf));
+		    	"concatenation failed: unable to alloc %llu bytes",
+			(Tcl_WideUInt)STRING_SIZE(length)));
 		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 		}
 		return TCL_ERROR;
@@ -2950,11 +2950,9 @@ TclStringCatObjv(
 	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
 	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
 		if (interp) {
-		    char buf[TCL_INTEGER_SPACE];
-		    sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length));
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    	"concatenation failed: unable to alloc %s bytes",
-			buf));
+		    	"concatenation failed: unable to alloc %llu bytes",
+			(Tcl_WideUInt)STRING_SIZE(length)));
 		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 		}
 		return TCL_ERROR;