From 5e2fde0cbb66a72f1a7eea2b830c3003696f4ca7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 Dec 2016 13:20:47 +0000
Subject: Created a new "proper bytearray" Tcl_ObjType so we can use bytearrays
 as bytearrays without all this fussing about over purity.

---
 generic/tclBinary.c | 65 ++++++++++++++++++++++++++++++++++++-----------------
 generic/tclInt.h    |  3 +--
 2 files changed, 45 insertions(+), 23 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 9a5771e..b27ab4d 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.
  */
 
+static const Tcl_ObjType properByteArrayType = {
+    "proper bytearray",
+    FreeByteArrayInternalRep,
+    DupByteArrayInternalRep,
+    UpdateStringOfByteArray,
+    NULL
+};
+
 const Tcl_ObjType tclByteArrayType = {
     "bytearray",
     FreeByteArrayInternalRep,
     DupByteArrayInternalRep,
-    UpdateStringOfByteArray,
+    NULL,
     SetByteArrayFromAny
 };
 
@@ -211,6 +219,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 +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/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);
 
 /*
  *----------------------------------------------------------------
-- 
cgit v0.12