Tcl Source Code

interpreter; however, variable
substitution and command substitution do not occur.
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.
.PP
If \fIindex\fR is 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.
.PP
If additional \fIindex\fR arguments are supplied, then each argument is

.PP
.CS
\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.
.SH EXAMPLES
.PP
In each of these examples, the initial value of \fIx\fR is:
.PP
.CS
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}
      \fI\(-> j k l\fR
\fBlset\fR x 0 j
      \fI\(-> j {d e f} {g h i}\fR
\fBlset\fR x 2 j
      \fI\(-> {a b c} {d e f} j\fR
\fBlset\fR x end j
      \fI\(-> {a b c} {d e f} j\fR
\fBlset\fR x end-1 j
      \fI\(-> {a b c} j {g h i}\fR
\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
.CE
.PP
In the following examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list [list a b] [list c d]] \e
            [list [list e f] [list g h]]]

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (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)) \
	    ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \

	    ? (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:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,

	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    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) {
		subListPtr = Tcl_NewObj();
	    } else {
		subListPtr = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its intrep with other
	     * 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) {


		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);

     * proper list - or something convertible to one - above).
     */

    len = -1;
    TclListObjLength(NULL, subListPtr, &len);
    if (valuePtr == NULL) {
	Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);

    } else if (index == len) {



	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);

    } else {
	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
	TclInvalidateStringRep(subListPtr);
    }
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (wide < 0) {
	*indexPtr = -1;


    } else if (wide > INT_MAX) {
	*indexPtr = INT_MAX;
    } else {
	*indexPtr = (int) wide;
    }
    return TCL_OK;
}

test lpop-1.2 {error conditions} -returnCodes error -body {
    lpop no 0
} -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 {
    set no "x y"
    lpop no -1
} -result {list index out of range}
test lpop-1.5 {error conditions} -returnCodes error -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 {
    set no "x y"
    lpop no end+1
} -result {list index out of range}
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 {
    set no "x y"
    lpop no 0 0 0 0 1
} -result {list index out of range}
test lpop-1.9 {error conditions} -returnCodes error -body {
    set no "x y"
    lpop no {1 0}
} -match glob -result {bad index *}

test lpop-2.1 {basic functionality} -body {
    set l "x y z"

    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
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}}
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}}
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}}
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}}
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}}
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
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 2a2 w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
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}}
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}}
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}}
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}}
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}}

test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
    list [catch {
	testevalex {lset noWrite 0 d}
    } msg] $msg $noWrite
} {1 {can't set "noWrite": trace failed} {d b c}}
test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {

test lset-8.4 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    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}}
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}}
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}}
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}}
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}}
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}}
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}}
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}}
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}}
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}}

test lset-9.1 {lset, not compiled, entire variable} testevalex {
    set a x
    list [testevalex {lset a y}] $a
} {y y}
test lset-9.2 {lset, not compiled, entire variable} testevalex {
    set a x

    list [testevalex {lset a $a {gag me}}] $a
} {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}

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 }"
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 }"

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
    testobj duplicate 1 2
    variable x [teststringobj get 1]

} "0 {{1 2} {3 5}}"

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}"

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 }"

test lsetComp-3.1 {lset, compiled, flat args, not a simple var name} {
    evalInProc {
	set y x
	set x {{1 2} {3 4}}
	lset $y 1 1 5
    }

} "0 {{1 2} {3 5}}"

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}"

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 }"

catch { rename evalInProc {} }
catch { unset ::x }
catch { unset ::y }

# cleanup
::tcltest::cleanupTests
return