From 3dcd08753c27584928c9a436994a06388befdd76 Mon Sep 17 00:00:00 2001
From: Kevin B Kenny <kennykb@acm.org>
Date: Mon, 3 Sep 2007 21:27:21 +0000
Subject: * tests/lindex.test (lindex-17.[01]):   Added code to detect the
 error when a script does [lindex {} end foo]; an overaggressive optimisation
 caused this call to return an empty object rather than an error.

---
 ChangeLog            |  6 ++++++
 generic/tclListObj.c | 11 +++++++++--
 tests/lindex.test    | 24 +++++++++++++++++++++++-
 3 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 211c56c..fc6ad39 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -17,6 +17,12 @@
 	* library/tzdata/Pacific/Auckland:
 	* library/tzdata/Pacific/Chatham: Olson's tzdata2007g.
 	
+	* generic/tclListObj.c (TclLindexFlat):
+	* tests/lindex.test (lindex-17.[01]):   Added code to detect the
+	error when a script does [lindex {} end foo]; an overaggressive
+	optimisation caused this call to return an empty object rather
+	than an error.
+	
 2007-09-03  Daniel Steffen  <das@users.sourceforge.net>
 
 	* generic/tclObj.c (TclInitObjSubsystem): restore registration of the
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 170831f..c1d1bfa 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclListObj.c,v 1.46 2007/04/24 22:31:39 msofer Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.47 2007/09/03 21:27:22 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -1108,10 +1108,17 @@ TclLindexFlat(
 	    if (index<0 || index>=listLen) {
 		/*
 		 * Index is out of range. Break out of loop with empty result.
+		 * First check remaining indices for validity
 		 */
 
+		while (++i < indexCount) {
+		    if (TclGetIntForIndex(interp, indexArray[i], -1, &index)
+			!= TCL_OK) {
+			Tcl_DecrRefCount(sublistCopy);
+			return NULL;
+		    }
+		}
 		listPtr = Tcl_NewObj();
-		i = indexCount;
 	    } else {
 		/*
 		 * Extract the pointer to the appropriate element.
diff --git a/tests/lindex.test b/tests/lindex.test
index 44ad429..37c840e 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: lindex.test,v 1.14 2007/01/09 11:32:35 dkf Exp $
+# RCS: @(#) $Id: lindex.test,v 1.15 2007/09/03 21:27:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -428,8 +428,30 @@ test lindex-16.7 {data reuse} {
     set result
 } {}
 
+test lindex-17.0 {Bug 1718580} {*}{
+    -body {
+        lindex {} end foo
+    } 
+    -match glob
+    -result {bad index "foo"*}
+    -returnCodes 1
+}
+
+test lindex-17.1 {Bug 1718580} {*}{
+    -body {
+        lindex a end foo
+    } 
+    -match glob
+    -result {bad index "foo"*}
+    -returnCodes 1
+}
+
 catch { unset minus }
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
-- 
cgit v0.12