Index: doc/lset.n ================================================================== --- doc/lset.n +++ doc/lset.n @@ -49,14 +49,14 @@ The command constructs a new list in which the designated element is 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 for the command \fBstring index\fR, supporting simple index arithmetic and indices relative to the end of the list. @@ -77,16 +77,14 @@ \fBlset\fR a {1 2} newValue .CE .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: .PP .CS @@ -93,12 +91,10 @@ set x [list [list a b c] [list d e f] [list g h i]] \fI\(-> {a b c} {d e f} {g h i}\fR .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} \fI\(-> j k l\fR \fBlset\fR x {} {j k l} @@ -114,11 +110,11 @@ \fBlset\fR x 2 1 j \fI\(-> {a b c} {d e f} {g j i}\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: .PP .CS Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -2509,14 +2509,14 @@ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(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))) /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -1600,34 +1600,20 @@ indexArray++; break; } 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 * take steps to make sure it is an unshared copy, as we intend to * modify it. */ if (--indexCount) { parentList = subListPtr; - if (index == elemCount) { + if (index >= elemCount || index < 0) { subListPtr = Tcl_NewObj(); } else { subListPtr = elemPtrs[index]; } if (Tcl_IsShared(subListPtr)) { @@ -1641,11 +1627,13 @@ * Tcl_Obj's. Dealing with the shared intrep case can cause * subListPtr to become shared again, so detect that case and make * 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); } if (Tcl_IsShared(subListPtr)) { @@ -1730,12 +1718,17 @@ len = -1; 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); } Tcl_IncrRefCount(retValuePtr); Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -3886,10 +3886,12 @@ if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { return TCL_ERROR; } if (wide < 0) { *indexPtr = -1; + } else if ((wide > endValue) && (endValue >= -1)) { + *indexPtr = endValue + 1; } else if (wide > INT_MAX) { *indexPtr = INT_MAX; } else { *indexPtr = (int) wide; } Index: tests/lpop.test ================================================================== --- tests/lpop.test +++ tests/lpop.test @@ -24,30 +24,30 @@ } -result {can't read "no": no such variable} 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} } -match glob -result {bad index *} Index: tests/lset.test ================================================================== --- tests/lset.test +++ tests/lset.test @@ -95,35 +95,35 @@ test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} 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 { testevalex {lset a 0 y} } msg] $msg @@ -137,35 +137,35 @@ test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} 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 { testevalex {lset noWrite 0 d} } msg] $msg $noWrite @@ -279,47 +279,47 @@ list [catch {testevalex {lset a {0 2a2} f}} msg] $msg } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} 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 list [testevalex {lset a y}] $a } {y y} @@ -402,16 +402,16 @@ test lset-14.1 {lset, not compiled, list 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}} 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 { teststringobj set 1 {{1 2} 3} testobj convert 1 list Index: tests/lsetComp.test ================================================================== --- tests/lsetComp.test +++ tests/lsetComp.test @@ -217,19 +217,19 @@ test lsetComp-2.8 {lset, compiled, list of args, error } { evalInProc { 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 } } evalInProc { 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 { set y x set x {{1 2} {3 4}} @@ -410,22 +410,22 @@ test lsetComp-3.8 {lset, compiled, flat args, error } { evalInProc { 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 } } evalInProc { 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 } catch { unset ::y } # cleanup ::tcltest::cleanupTests return