Fix bug [c25d2cd3e6], as well as memory leaks in lsearch and concat.

Add cleanup to some tests.
Fix bug and leak in tclTestABSList.c
Correct comment in tclArithSeries.c

6 files changed, 48 insertions, 15 deletions

diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index caf701b..166c1c9 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -588,11 +588,12 @@ TclNewArithSeriesObj(
  *
  * Results:
  *
- * 	TCL_OK on success, TCL_ERROR on index out of range.
+ * 	TCL_OK on success.
  *
  * Side Effects:
  *
  * 	On success, the integer pointed by *element is modified.
+ * 	An empty string ("") is assigned if index is out-of-bounds.
  *
  *----------------------------------------------------------------------
  */
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index d52d6d5..663d962 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2635,7 +2635,7 @@ Tcl_LpopObjCmd(
     Tcl_Size listLen;
     int copied = 0, result;
     Tcl_Obj *elemPtr, *stored;
-    Tcl_Obj *listPtr, **elemPtrs;
+    Tcl_Obj *listPtr;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
@@ -2647,7 +2647,7 @@ Tcl_LpopObjCmd(
 	return TCL_ERROR;
     }
 
-    result = TclListObjGetElementsM(interp, listPtr, &listLen, &elemPtrs);
+    result = TclListObjLengthM(interp, listPtr, &listLen);
     if (result != TCL_OK) {
 	return result;
     }
@@ -2666,7 +2666,12 @@ Tcl_LpopObjCmd(
 		"OUTOFRANGE", NULL);
 	    return TCL_ERROR;
 	}
-	elemPtr = elemPtrs[listLen - 1];
+
+	result = Tcl_ListObjIndex(interp, listPtr, (listLen-1),	&elemPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+
 	Tcl_IncrRefCount(elemPtr);
     } else {
 	elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);
@@ -2699,7 +2704,13 @@ Tcl_LpopObjCmd(
 	    return result;
 	}
     } else {
-	Tcl_Obj *newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
+	Tcl_Obj *newListPtr;
+	Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(listPtr, setElementProc);
+	if (proc) {
+	    newListPtr = proc(interp, listPtr, objc-2, objv+2, NULL);
+	} else {
+	    newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
+	}
 	if (newListPtr == NULL) {
 	    if (copied) {
 		Tcl_DecrRefCount(listPtr);
@@ -3946,6 +3957,7 @@ Tcl_LsearchObjCmd(
 		 */
 
 		if (returnSubindices && (sortInfo.indexc != 0)) {
+		    Tcl_BumpObj(itemPtr);
 		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
 			    &sortInfo);
 		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
@@ -3953,6 +3965,7 @@ Tcl_LsearchObjCmd(
 		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
 			    groupSize, &listv[i]);
 		} else {
+		    Tcl_BumpObj(itemPtr);
 		    itemPtr = listv[i];
 		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
 		}
@@ -4023,6 +4036,9 @@ Tcl_LsearchObjCmd(
      */
 
   done:
+    /* potential lingering abstract list element */
+    Tcl_BumpObj(itemPtr);
+
     if (startPtr != NULL) {
 	Tcl_DecrRefCount(startPtr);
     }
diff --git a/generic/tclTestABSList.c b/generic/tclTestABSList.c
index f9f2fda..7ac6308 100644
--- a/generic/tclTestABSList.c
+++ b/generic/tclTestABSList.c
@@ -361,7 +361,6 @@ my_LStringObjSetElem(
 {
     LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
     Tcl_Size index;
-    const char *newvalue;
     int status;
     Tcl_Obj *returnObj;
 
@@ -385,8 +384,17 @@ my_LStringObjSetElem(
 	lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
     }
 
-    newvalue = Tcl_GetString(valueObj);
-    lstringRepPtr->string[index] = newvalue[0];
+    if (valueObj) {
+	const char newvalue = Tcl_GetString(valueObj)[0];
+	lstringRepPtr->string[index] = newvalue;
+    } else if (index < lstringRepPtr->strlen) {
+	/* Remove the char by sliding the tail of the string down */
+	char *sptr = &lstringRepPtr->string[index];
+	/* This is an overlapping copy, by definition */
+	lstringRepPtr->strlen--;
+	memmove(sptr, (sptr+1), (lstringRepPtr->strlen - index));
+    }
+    // else do nothing
 
     Tcl_InvalidateStringRep(returnObj);
 
@@ -684,6 +692,7 @@ my_NewLStringObj(
 	i++;
     }
     if (i != objc-1) {
+	Tcl_Free((char*)lstringRepPtr);
 	Tcl_WrongNumArgs(interp, 0, objv, "lstring string");
 	return NULL;
     }
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index ac292db..1fdcda3 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2005,8 +2005,10 @@ Tcl_ConcatObj(
 			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
 		    /* Abandon ship! */
 		    Tcl_DecrRefCount(resPtr);
+		    Tcl_BumpObj(elemPtr); // could be an abstract list element
 		    goto slow;
 		}
+		Tcl_BumpObj(elemPtr); // could be an an abstract list element
 	    } else {
 		resPtr = TclDuplicatePureObj(
 		    NULL, objPtr, &tclListType);
diff --git a/tests/abstractlist.test b/tests/abstractlist.test
index 4335daa..5c92048 100644
--- a/tests/abstractlist.test
+++ b/tests/abstractlist.test
@@ -41,13 +41,15 @@ test abstractlist-1.1 {error cases} -body {
 } -returnCodes 1 \
     -result {wrong # args: should be "lstring string"}
 
-test abstractlist-2.0 {no shimmer llength} {
+test abstractlist-2.0 {no shimmer llength} -body {
     set l [lstring $str]
     set l-isa [testobj objtype $l]
     set len [llength $l]
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${len} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}
+} -cleanup {
+unset l
+} -result {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}
 
 test abstractlist-2.1 {no shimmer lindex} {
     set l [lstring $str]
@@ -501,14 +503,15 @@ test abstractlist-$not-4.11e {error case lset multiple indicies} \
     -result {Multiple indicies not supported by lstring.}
 
 # lrepeat
-test abstractlist-$not-4.12 {shimmer lrepeat} {
+test abstractlist-$not-4.12 {shimmer lrepeat} -body {
     set l [lstring {*}$options Inconceivable]
     set l-isa [testobj objtype $l]
     set m [lrepeat 3 $l]
     set m-isa [testobj objtype $m]
     set n [lindex $m 1]
     list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
-} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}
+} -cleanup {
+} -result {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}
 
 # Disable constraint
 testConstraint [format "%sShimmer" [string totitle $not]] 1
diff --git a/tests/lseq.test b/tests/lseq.test
index 6082856..4544675 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -455,7 +455,7 @@ test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble} {
 # lsearch -
 #  -- should not shimmer lseq  list
 #  -- should not leak lseq elements
-test lseq-3.32 {lsearch nested lists of lseq} arithSeriesShimmer {
+test lseq-3.32 {lsearch nested lists of lseq} -constraints arithSeriesShimmer -body {
     set srchlist {}
     for {set i 5} {$i < 25} {incr i} {
 	lappend srchlist [lseq $i count 7 by 3]
@@ -464,7 +464,9 @@ test lseq-3.32 {lsearch nested lists of lseq} arithSeriesShimmer {
     set b [lmap i $a {lindex [tcl::unsupported::representation $i] 3}]
     list [lindex [tcl::unsupported::representation $a] 3] $a $b \
         [lindex [tcl::unsupported::representation [lindex $srchlist 15]] 3]
-} {list {{20 23 26 29 32 35 38}} arithseries arithseries}
+} -cleanup {
+    unset a b srchlist i
+} -result {list {{20 23 26 29 32 35 38}} arithseries arithseries}
 
 
 # lsearch -
@@ -725,7 +727,7 @@ test lseq-bug-54329e39c7 {does not cause memory bloat} -constraints {
     set premem [memusage]
     p $l
     set postmem [memusage]
-    expr {($postmem - $premem) < 10}
+    expr {[string match *purify* [tcl::build-info]] || ($postmem - $premem < 10) ? 1 : ($postmem - $premem)}
 } -result 1
 
 # cleanup