Final prep for TIP625 vote

2 files changed, 84 insertions, 22 deletions

diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 6e195e3..43307ad 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -12,8 +12,11 @@
 #include "tclInt.h"
 #include <assert.h>
 
-/* TODO - memmove is fast. Measure at what size we should prefer memmove
-   (for unshared objects only) in lieu of range operations */
+/*
+ * TODO - memmove is fast. Measure at what size we should prefer memmove
+ * (for unshared objects only) in lieu of range operations. On the other
+ * hand, more cache dirtied?
+ */
 
 /*
  * Macros for validation and bug checking.
@@ -1451,7 +1454,7 @@ ListRepRange(
     if (!preserveSrcRep) {
         /* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
 	ListRepFreeUnreferenced(srcRepPtr);
-    }
+    } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
 
     if (rangeStart < 0) {
 	rangeStart = 0;
@@ -1486,7 +1489,7 @@ ListRepRange(
      */
     if (rangeStart == 0 && rangeEnd == (numSrcElems-1)) {
 	/* Option 0 - entire list. This may be used to canonicalize */
-        /* T:listrep-1.10.1 */
+        /* T:listrep-1.10.1,2.8.1 */
 	*rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */
     } else if (rangeStart == 0 && (!preserveSrcRep)
 	       && (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) {
@@ -1513,7 +1516,7 @@ ListRepRange(
 	if (!preserveSrcRep && srcRepPtr->spanPtr
 	    && srcRepPtr->spanPtr->refCount <= 1) {
 	    /* If span is not shared reuse it */
-            /* T:listrep-3.{16,18} */
+            /* T:listrep-2.7.3,3.{16,18} */
 	    srcRepPtr->spanPtr->spanStart = spanStart;
 	    srcRepPtr->spanPtr->spanLength = rangeLen;
 	    *rangeRepPtr = *srcRepPtr;
@@ -1636,7 +1639,7 @@ TclListObjRange(
     ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);
 
     if (isShared) {
-        /* T:listrep-1.10.1 */
+        /* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
 	TclNewObj(listObj);
     } /* T:listrep-1.{4.3,5.1,5.2} */
     ListObjReplaceRepAndInvalidate(listObj, &resultRep);
@@ -1846,7 +1849,7 @@ Tcl_ListObjAppendList(
 	    LIST_ASSERT(listRep.spanPtr->spanStart
 			== listRep.storePtr->firstUsed);
 	    listRep.spanPtr->spanLength = finalLen;
-	}
+	} /* else T:listrep-3.6.3 */
 	LIST_ASSERT(ListRepStart(&listRep) == listRep.storePtr->firstUsed);
 	LIST_ASSERT(ListRepLength(&listRep) == finalLen);
 	LISTREP_CHECK(&listRep);
@@ -2179,7 +2182,7 @@ Tcl_ListObjReplace(
     if (numToDelete == 0) {
 	/* Case (2a) - Append to list. */
 	if (first == origListLen) {
-            /* T:listrep-1.11,2.9,3.{5,6} */
+            /* T:listrep-1.11,2.9,3.{5,6},2.2.1 */
 	    return TclListObjAppendElements(
 		interp, listObj, numToInsert, insertObjs);
 	}
@@ -2740,7 +2743,7 @@ TclLsetList(
 	&& TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
 	       == TCL_OK) {
 	/* indexArgPtr designates a single index. */
-        /* T:listrep-1.{2.1,12.1,15.1,19.1} */
+        /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
 	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
     }
 
@@ -3023,13 +3026,13 @@ TclLsetFlat(
     len = -1;
     TclListObjLengthM(NULL, subListObj, &len);
     if (valueObj == NULL) {
-        /* T:listrep-1.{4.2,5.4,6.1,7.1,8.3} */
+        /* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */
 	Tcl_ListObjReplace(NULL, subListObj, index, 1, 0, NULL);
     } else if (index == len) {
-        /* T:listrep-1.2.1 */
+        /* T:listrep-1.2.1,2.{2.3,9.3},3.{4,5,6}.3 */
 	Tcl_ListObjAppendElement(NULL, subListObj, valueObj);
     } else {
-        /* T:listrep-1.{12.1,15.1,19.1} */
+        /* T:listrep-1.{12.1,15.1,19.1},2.{10,13,16}.1 */
 	TclListObjSetElement(NULL, subListObj, index, valueObj);
 	TclInvalidateStringRep(subListObj);
     }
@@ -3102,6 +3105,7 @@ TclListObjSetElement(
     /* Replace a shared internal rep with an unshared copy */
     if (listRep.storePtr->refCount > 1) {
 	ListRep newInternalRep;
+        /* T:listrep-2.{10,13,16}.1 */
 	/* TODO - leave extra space? */
 	ListRepClone(&listRep, &newInternalRep, LISTREP_PANIC_ON_FAIL);
 	listRep = newInternalRep;
diff --git a/tests/listRep.test b/tests/listRep.test
index 9cfaeb2..7d0dda2 100644
--- a/tests/listRep.test
+++ b/tests/listRep.test
@@ -2306,17 +2306,75 @@ test listrep-4.18 {
 } -result [list [irange 2 997] [concat [irange 2 994] {1000 1001 1002 997}] 0 1 1 2 1]
 
 #
-# Tests when tcl-obj is shared but listrep is not (lappend, lset etc.)
+# Tests when tcl-obj is shared but listrep is not. This is to ensure that
+# checks for shared values check the Tcl_Obj reference counts in addition to
+# the list internal representation reference counts. Probably some or all
+# cases are already covered elsewhere but easier to just test than look.
+test listrep-5.1 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
+    list representation only modifies the target object - lappend version
+} -constraints testlistrep -body {
+    set l [freeSpaceNone]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lappend l 8
+    list $same $l $l2 [sameStore $l $l2]
+} -result [list 1 [irange 0 8] [irange 0 7] 0]
 
-# TBD - canonical output on shared and spanned lists (see 1.10)
-# TBD - range and subrange tests
-#       - spanned and unspanned
-# TBD - zombie tests
-#
-# Special cases
-# - nested lset (does not seem tested in 8.6)
-# - lremove with multiple indices
-# - nested lpop
+test listrep-5.1.1 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
+    list representation only modifies the target object - lset version
+} -constraints testlistrep -body {
+    set l [freeSpaceNone]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lset l $end+1 8
+    list $same $l $l2 [sameStore $l $l2]
+} -result [list 1 [irange 0 8] [irange 0 7] 0]
+
+test listrep-5.1.2 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
+    list representation only modifies the target object - lpop version
+} -constraints testlistrep -body {
+    set l [freeSpaceNone]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lpop l
+    list $same $l $l2 [sameStore $l $l2] [hasSpan $l]
+} -result [list 1 [irange 0 6] [irange 0 7] 0 0]
+
+test listrep-5.2 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
+    list representation only modifies the target object - lappend version
+} -constraints testlistrep -body {
+    set l [freeSpaceBoth 1000 10 10]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lappend l 1000
+    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
+} -result [list 1 [irange 0 1000] [irange 0 999] 0 1 1]
+
+test listrep-5.2.1 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
+    list representation only modifies the target object - lset version
+} -constraints testlistrep -body {
+    set l [freeSpaceBoth 1000 10 10]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lset l $end+1 1000
+    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
+} -result [list 1 [irange 0 1000] [irange 0 999] 0 1 1]
+
+test listrep-5.2.2 {
+    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
+    list representation only modifies the target object - lpop version
+} -constraints testlistrep -body {
+    set l [freeSpaceNone 1000]
+    set l2 $l
+    set same [sameStore $l $l2]
+    lpop l
+    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
+} -result [list 1 [irange 0 998] [irange 0 999] 1 1 0]
 
 ::tcltest::cleanupTests
 return