summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2018-03-26 16:27:40 (GMT)
committerdgp <dgp@users.sourceforge.net>2018-03-26 16:27:40 (GMT)
commit1a73baff0989dad465da8fd91f32d537bf704367 (patch)
tree62bf411067be2437cf7200348256493a0c0a9dc0
parent05c789647adebac2a77a4910a46810e94cad3efe (diff)
downloadtcl-1a73baff0989dad465da8fd91f32d537bf704367.zip
tcl-1a73baff0989dad465da8fd91f32d537bf704367.tar.gz
tcl-1a73baff0989dad465da8fd91f32d537bf704367.tar.bz2
Work in progress implementing TIP 505.
-rw-r--r--generic/tclCmdIL.c17
-rw-r--r--generic/tclCompCmdsGR.c1
-rw-r--r--tests/lreplace.test8
3 files changed, 8 insertions, 18 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3b2cb19..10fbd3f 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2747,21 +2747,10 @@ Tcl_LreplaceObjCmd(
if (first < 0) {
first = 0;
}
-
- /*
- * Complain if the user asked for a start element that is greater than the
- * list length. This won't ever trigger for the "end-*" case as that will
- * be properly constrained by TclGetIntForIndex because we use listLen-1
- * (to allow for replacing the last elem).
- */
-
- if ((first >= listLen) && (listLen > 0)) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "list doesn't contain element %s", TclGetString(objv[2])));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
- NULL);
- return TCL_ERROR;
+ if (first > listLen) {
+ first = listLen;
}
+
if (last >= listLen) {
last = listLen - 1;
}
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 396947c..ce324c8 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1478,6 +1478,7 @@ TclCompileLreplaceCmd(
if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
+return TCL_ERROR;
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
tokenPtr = TokenAfter(listTokenPtr);
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 4a6b853..fd2f7f8 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -100,10 +100,10 @@ test lreplace-1.26 {lreplace command} {
} {a {} {}}
test lreplace-1.27 {lreplace command} -body {
lreplace x 1 1
-} -returnCodes 1 -result {list doesn't contain element 1}
+} -result x
test lreplace-1.28 {lreplace command} -body {
lreplace x 1 1 y
-} -returnCodes 1 -result {list doesn't contain element 1}
+} -result {x y}
test lreplace-1.29 {lreplace command} -body {
lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
@@ -128,10 +128,10 @@ test lreplace-2.5 {lreplace errors} {
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
list [catch {lreplace x 3 2} msg] $msg
-} {1 {list doesn't contain element 3}}
+} {0 x}
test lreplace-2.7 {lreplace errors} {
list [catch {lreplace x 2 2} msg] $msg
-} {1 {list doesn't contain element 2}}
+} {0 x}
test lreplace-3.1 {lreplace won't modify shared argument objects} {
proc p {} {