Merge 8.7

1 files changed, 26 insertions, 18 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index cd259ef..5c18f5e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -999,7 +999,7 @@ TclDbDumpActiveObjects(
     tablePtr = tsdPtr->objThreadMap;
 
     if (tablePtr != NULL) {
-	fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries);
+	fprintf(outFile, "total objects: %" TCL_SIZE_MODIFIER "d\n", tablePtr->numEntries);
 	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
 		hPtr = Tcl_NextHashEntry(&hSearch)) {
 	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
@@ -1053,7 +1053,7 @@ TclDbInitNewObj(
 {
     objPtr->refCount = 0;
     objPtr->typePtr = NULL;
-    TclInitStringRep(objPtr, NULL, 0);
+    TclInitEmptyStringRep(objPtr);
 
 #if TCL_THREADS
     /*
@@ -1195,7 +1195,9 @@ Tcl_DbNewObj(
     TCL_UNUSED(const char *) /*file*/,
     TCL_UNUSED(int) /*line*/)
 {
-    return Tcl_NewObj();
+    Tcl_Obj *objPtr;
+    TclNewObj(objPtr);
+    return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
 
@@ -1589,7 +1591,7 @@ Tcl_DuplicateObj(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_DuplicatePureObj --
+ * TclDuplicatePureObj --
  *
  *	Duplicates a Tcl_Obj and converts the internal representation of the
  *	duplicate to the given type, changing neither the 'bytes' field
@@ -1656,7 +1658,14 @@ int SetDuplicatePureObj(
 	|| typePtr == &tclStringType
 	)
     ) {
-	TclInitStringRep(dupPtr, bytes, objPtr->length);
+	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"insufficient memory to initialize string", -1));
+		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	    }
+	    status = TCL_ERROR;
+	}
     }
     return status;
 }
@@ -1915,7 +1924,7 @@ Tcl_InitStringRep(
     if (objPtr->bytes == NULL) {
 	/* Start with no string rep */
 	if (numBytes == 0) {
-	    TclInitStringRep(objPtr, NULL, 0);
+	    TclInitEmptyStringRep(objPtr);
 	    return objPtr->bytes;
 	} else {
 	    objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1);
@@ -1942,7 +1951,7 @@ Tcl_InitStringRep(
 	/* Start with non-empty string rep (allocated) */
 	if (numBytes == 0) {
 	    Tcl_Free(objPtr->bytes);
-	    TclInitStringRep(objPtr, NULL, 0);
+	    TclInitEmptyStringRep(objPtr);
 	    return objPtr->bytes;
 	} else {
 	    objPtr->bytes = (char *)Tcl_AttemptRealloc(objPtr->bytes,
@@ -2010,8 +2019,9 @@ Tcl_HasStringRep(
  *	Called to set the object's internal representation to match a
  *	particular type.
  *
- *	It is the caller's resonsibility to ensure that the given IntRep is
- *	appropriate for the existing string.
+ *	It is the caller's responsibility to guarantee that
+ *	the value of the submitted internalrep is in agreement with
+ *	the value of any existing string rep.
  *
  * Results:
  *	None.
@@ -2027,16 +2037,14 @@ void
 Tcl_StoreInternalRep(
     Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
     const Tcl_ObjType *typePtr,	/* New type for the object */
-    const Tcl_ObjInternalRep *irPtr)	/* New IntRep for the object */
+    const Tcl_ObjInternalRep *irPtr)	/* New internalrep for the object */
 {
-    /* Clear out any existing IntRep.  This is the point where shimmering, i.e.
-     * repeated alteration of the type of the internal representation, may
-     * occur. */
+    /* Clear out any existing internalrep ( "shimmer" ) */
     TclFreeInternalRep(objPtr);
 
-    /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
+    /* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */
     if (irPtr) {
-	/* Copy the new IntRep into place */
+	/* Copy the new internalrep into place */
 	objPtr->internalRep = *irPtr;
 
 	/* Set the type to match */
@@ -3507,7 +3515,7 @@ GetBignumFromObj(
 		 * bignum values are converted to empty string.
 		 */
 		if (objPtr->bytes == NULL) {
-		    TclInitStringRep(objPtr, NULL, 0);
+		    TclInitEmptyStringRep(objPtr);
 		}
 	    }
 	    return TCL_OK;
@@ -3871,7 +3879,7 @@ int
 Tcl_IsShared(
     Tcl_Obj *objPtr)	/* The object to test for being shared. */
 {
-    return ((objPtr)->refCount + 1 > 2);
+    return ((objPtr)->refCount > 1);
 }
 
 /*
@@ -4314,7 +4322,7 @@ TclHashObjKey(
      * See [tcl-Feature Request #2958832]
      */
 
-    if (length) {
+    if (length > 0) {
 	result = UCHAR(*string);
 	while (--length) {
 	    result += (result << 3) + UCHAR(*++string);