Handle endValue < -1. Improve documentation of new behavior.

doc/lset.n

@@ -51,10 +51,10 @@ replaced with \fInewValue\fR.  This new list is stored in the
 variable \fIvarName\fR, and is also the return value from the \fBlset\fR
 command.
 .PP
-If \fIindex\fR is negative or greater than the number
-of elements in \fI$varName\fR, then an error occurs.
+If \fIindex\fR is negative, then the given element will be prepended
+to the list.
 .PP
-If \fIindex\fR is equal to the number of elements in \fI$varName\fR,
+If \fIindex\fR is greater or equal to the number of elements in \fI$varName\fR,
 then the given element is appended to the list.
 .PP
 The interpretation of each simple \fIindex\fR value is the same as
@@ -79,12 +79,10 @@ or
 .PP
 replaces element 2 of sublist 1 with \fInewValue\fR.
 .PP
-The integer appearing in each \fIindex\fR argument must be greater
-than or equal to zero.  The integer appearing in each \fIindex\fR
-argument must be less than or equal to the length of the corresponding
-list.  In other words, the \fBlset\fR command can change the size
-of a list only by appending an element (setting the one after the current
-end).  If an index is outside the permitted range, an error is reported.
+The \fBlset\fR command can change the size
+of a list only by prepending an element (setting the first argument, moving the
+remaining ones up) or appending an element (setting the one after the current
+end).
 .SH EXAMPLES
 .PP
 In each of these examples, the initial value of \fIx\fR is:
@@ -95,8 +93,6 @@ set x [list [list a b c] [list d e f] [list g h i]]
 .CE
 .PP
 The indicated return value also becomes the new value of \fIx\fR
-(except in the last case, which is an error which leaves the value of
-\fIx\fR unchanged.)
 .PP
 .CS
 \fBlset\fR x {j k l}
@@ -116,7 +112,7 @@ The indicated return value also becomes the new value of \fIx\fR
 \fBlset\fR x {2 1} j
       \fI\(-> {a b c} {d e f} {g j i}\fR
 \fBlset\fR x {2 3} j
-      \fI\(-> list index out of range\fR
+      \fI\(-> {a b c} {d e f} {g h i j}\fR
 .CE
 .PP
 In the following examples, the initial value of \fIx\fR is:

generic/tclInt.h

@@ -2511,10 +2511,10 @@ typedef struct List {
 	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
 #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
-    (((objPtr)->typePtr == &tclIntType \
-	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
+    ((((objPtr)->typePtr == &tclIntType) && ((endValue) >= -1)) \
 	    ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \
-	    ? (int)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \
+	    ? ((((objPtr)->internalRep.wideValue > (endValue))) ? ((endValue) + 1) \
+	    : ((int)(objPtr)->internalRep.wideValue)) : TCL_INDEX_NONE), TCL_OK) \
 	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
 
 /*

generic/tclListObj.c

@@ -1602,20 +1602,6 @@ TclLsetFlat(
 	}
 	indexArray++;
 
-	if (index < 0 || index > elemCount
-		|| (valuePtr == NULL && index >= elemCount)) {
-	    /* ...the index points outside the sublist. */
-	    if (interp != NULL) {
-		Tcl_SetObjResult(interp,
-			Tcl_NewStringObj("list index out of range", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION",
-			valuePtr == NULL ? "LPOP" : "LSET",
-			"BADINDEX", NULL);
-	    }
-	    result = TCL_ERROR;
-	    break;
-	}
-
 	/*
 	 * No error conditions.  As long as we're not yet on the last index,
 	 * determine the next sublist for the next pass through the loop, and
@@ -1625,7 +1611,7 @@ TclLsetFlat(
 
 	if (--indexCount) {
 	    parentList = subListPtr;
-	    if (index == elemCount) {
+	    if (index >= elemCount || index < 0) {
 		subListPtr = Tcl_NewObj();
 	    } else {
 		subListPtr = elemPtrs[index];
@@ -1643,7 +1629,9 @@ TclLsetFlat(
 	     * and store another copy.
 	     */
 
-	    if (index == elemCount) {
+	    if (index < 0) {
+		Tcl_ListObjReplace(NULL, parentList, 0, 0, 1, &subListPtr);
+	    } else if (index >= elemCount) {
 		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
 	    } else {
 		TclListObjSetElement(NULL, parentList, index, subListPtr);
@@ -1732,8 +1720,13 @@ TclLsetFlat(
     TclListObjLength(NULL, subListPtr, &len);
     if (valuePtr == NULL) {
 	Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
-    } else if (index == len) {
+	TclInvalidateStringRep(subListPtr);
+    } else if (index < 0) {
+	Tcl_ListObjReplace(NULL, subListPtr, 0, 0, 1, &valuePtr);
+	TclInvalidateStringRep(subListPtr);
+    } else if (index >= len) {
 	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
+	TclInvalidateStringRep(subListPtr);
     } else {
 	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
 	TclInvalidateStringRep(subListPtr);

generic/tclUtil.c

@@ -3888,6 +3888,8 @@ Tcl_GetIntForIndex(
     }
     if (wide < 0) {
 	*indexPtr = -1;
+    } else if ((wide > endValue) && (endValue >= -1)) {
+	*indexPtr = endValue + 1;
     } else if (wide > INT_MAX) {
 	*indexPtr = INT_MAX;
     } else {

tests/lpop.test

@@ -26,26 +26,26 @@ test lpop-1.3 {error conditions} -returnCodes error -body {
     set no "x {}x"
     lpop no
 } -result {list element in braces followed by "x" instead of space}
-test lpop-1.4 {error conditions} -returnCodes error -body {
+test lpop-1.4 {error conditions} -body {
     set no "x y"
     lpop no -1
-} -result {list index out of range}
-test lpop-1.5 {error conditions} -returnCodes error -body {
+} -result {}
+test lpop-1.5 {error conditions} -body {
     set no "x y z"
     lpop no 3
-} -result {list index out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX}
-test lpop-1.6 {error conditions} -returnCodes error -body {
+} -result {}
+test lpop-1.6 {error conditions} -body {
     set no "x y"
     lpop no end+1
-} -result {list index out of range}
+} -result {}
 test lpop-1.7 {error conditions} -returnCodes error -body {
     set no "x y"
     lpop no {}
 } -match glob -result {bad index *}
-test lpop-1.8 {error conditions} -returnCodes error -body {
+test lpop-1.8 {error conditions} -body {
     set no "x y"
     lpop no 0 0 0 0 1
-} -result {list index out of range}
+} -result {}
 test lpop-1.9 {error conditions} -returnCodes error -body {
     set no "x y"
     lpop no {1 0}

tests/lset.test

@@ -97,31 +97,31 @@ test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
     list [catch {
 	testevalex {lset a [list -1] w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {w x y z}}
 test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list 4] w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list end--2] w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list end+2] w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list end-3] w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {w x y z}}
 test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
     set a "x \{"
     list [catch {
@@ -139,31 +139,31 @@ test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
     list [catch {
 	testevalex {lset a -1 w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {w x y z}}
 test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a 4 w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a end--2 w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a end+2 w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {x y z w}}
 test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a end-3 w}
     } msg] $msg
-} {1 {list index out of range}}
+} {0 {w x y z}}
 
 test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
     list [catch {
@@ -281,43 +281,43 @@ test lset-8.4 {lset, not compiled, bad second index} testevalex {
 test lset-8.5 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 -1 h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {h f g}}}
 test lset-8.6 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 -1} h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {h f g}}}
 test lset-8.7 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 3 h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.8 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 3} h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.9a {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.9b {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.10a {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.10b {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {f g h}}}
 test lset-8.11 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {h f g}}}
 test lset-8.12 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
-} {1 {list index out of range}}
+} {0 {{b c} {d e} {h f g}}}
 
 test lset-9.1 {lset, not compiled, entire variable} testevalex {
     set a x
@@ -404,12 +404,12 @@ test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testeva
     set a { { 1 2 } { 3 4 } }
     catch { testevalex {lset a {1 5} 5} }
     list $a [lindex $a 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
+} {{{ 1 2 } {3 4 5}} {3 4 5}}
 test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
     set a { { 1 2 } { 3 4 } }
     catch { testevalex {lset a 1 5 5} }
     list $a [lindex $a 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
+} {{{ 1 2 } {3 4 5}} {3 4 5}}
 
 testConstraint testobj [llength [info commands testobj]]
 test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {

tests/lsetComp.test

@@ -219,7 +219,7 @@ test lsetComp-2.8 {lset, compiled, list of args, error } {
 	set x { {1 2} {3 4} }
 	lset x {1 5} 5
     }
-} "1 {list index out of range}"
+} {0 {{1 2} {3 4 5}}}
 
 test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} {
     set ::x { { 1 2 } { 3 4 } }
@@ -227,7 +227,7 @@ test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} {
 	lset ::x { 1 5 } 5
     }
     list $::x [lindex $::x 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
+} {{{ 1 2 } {3 4 5}} {3 4 5}}
 
 test lsetComp-3.1 {lset, compiled, flat args, not a simple var name} {
     evalInProc {
@@ -412,7 +412,7 @@ test lsetComp-3.8 {lset, compiled, flat args, error } {
 	set x { {1 2} {3 4} }
 	lset x 1 5 5
     }
-} "1 {list index out of range}"
+} {0 {{1 2} {3 4 5}}}
 
 test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} {
     set ::x { { 1 2 } { 3 4 } }
@@ -420,7 +420,7 @@ test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} {
 	lset ::x 1 5 5
     }
     list $::x [lindex $::x 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
+} {{{ 1 2 } {3 4 5}} {3 4 5}}
 
 catch { rename evalInProc {} }
 catch { unset ::x }