Fix for [c2dfd8b7ea]. Remove assumption about Tcl list intreps

tcltk · Jun 6, 2024 · b9b7405 · b9b7405
1 parent 0fa4301
commit b9b7405
Showing 1 changed file with 34 additions and 23 deletions.
diff --git a/generic/threadSvListCmd.c b/generic/threadSvListCmd.c
@@ -927,8 +927,12 @@ SvLsetFlat(
      Tcl_Obj *valuePtr      /* Value arg to 'lset' */
 ) {
     Tcl_Size i, elemCount, index;
-	int result;
-    Tcl_Obj **elemPtrs, *chainPtr, *subListPtr;
+    int result;
+    Tcl_Obj **elemPtrs, *subListPtr;
+    Tcl_Obj *pendingInvalidates[10]; /* Assumed max nesting depth */
+    Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
+    Tcl_Size numPendingInvalidates = 0;
+
 
     /*
      * Determine whether the index arg designates a list
@@ -955,12 +959,12 @@ SvLsetFlat(
         return valuePtr;
     }
 
-    /*
-     * Anchor the linked list of Tcl_Obj's whose string reps must be
-     * invalidated if the operation succeeds.
-     */
-
-    chainPtr = NULL;
+    /* Allocate if static array for pending invalidations is too small */
+    if (indexCount > (Tcl_Size) (sizeof(pendingInvalidates) /
+                            sizeof(pendingInvalidates[0]))) {
+	pendingInvalidatesPtr =
+	    (Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr));
+    }
 
     /*
      * Handle each index arg by diving into the appropriate sublist
@@ -977,8 +981,6 @@ SvLsetFlat(
             break;
         }
 
-        listPtr->internalRep.twoPtrValue.ptr2 = (void*)chainPtr;
-
         /*
          * Determine the index of the requested element.
          */
@@ -992,7 +994,7 @@ SvLsetFlat(
          * Check that the index is in range.
          */
 
-        if (index >= elemCount) {
+        if (index < 0 || index >= elemCount) {
             Tcl_SetObjResult(interp,
                              Tcl_NewStringObj("list index out of range", TCL_INDEX_NONE));
             result = TCL_ERROR;
@@ -1012,13 +1014,17 @@ SvLsetFlat(
          * Extract the appropriate sublist and chain it onto the linked
          * list of Tcl_Obj's whose string reps must be spoilt.
          */
+        pendingInvalidatesPtr[numPendingInvalidates] = listPtr;
+        ++numPendingInvalidates;
 
         subListPtr = elemPtrs[index];
-        chainPtr = listPtr;
         listPtr = subListPtr;
     }
 
-    /* Store the result in the list element */
+    /*
+     * At this point listPtr holds the sublist (which could even be the
+     * top level list) whose element is to be modified.
+     */
 
     if (result == TCL_OK) {
         result = Tcl_ListObjGetElements(interp,listPtr,&elemCount,&elemPtrs);
@@ -1030,19 +1036,24 @@ SvLsetFlat(
     }
 
     if (result == TCL_OK) {
-        listPtr->internalRep.twoPtrValue.ptr2 = (void*)chainPtr;
-        /* Spoil all the string reps */
-        while (listPtr != NULL) {
-            subListPtr = (Tcl_Obj*)listPtr->internalRep.twoPtrValue.ptr2;
-            Tcl_InvalidateStringRep(listPtr);
-            listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-            listPtr = subListPtr;
-        }
+        /*
+         * Since modification was successful, we need to invalidate string
+         * representations of all ancestors of the modified sublist.
+         */
+	while (numPendingInvalidates > 0) {
+	    Tcl_Obj *objPtr;
 
-        return valuePtr;
+	    --numPendingInvalidates;
+	    Tcl_InvalidateStringRep(pendingInvalidatesPtr[numPendingInvalidates]);
+	}
+    }
+
+    if (pendingInvalidatesPtr != pendingInvalidates) {
+	Tcl_Free(pendingInvalidatesPtr);
     }
 
-    return NULL;
+    /* Note return only matters as non-NULL vs NULL */
+    return result == TCL_OK ? valuePtr : NULL;
 }
 
 /* EOF $RCSfile: threadSvListCmd.c,v $ */