From 1a73baff0989dad465da8fd91f32d537bf704367 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 26 Mar 2018 16:27:40 +0000
Subject: Work in progress implementing TIP 505.

---
 generic/tclCmdIL.c      | 17 +++--------------
 generic/tclCompCmdsGR.c |  1 +
 tests/lreplace.test     |  8 ++++----
 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 {} {
-- 
cgit v0.12