Subject: [Bug 3588366]: Corrected implementation of bounds restriction for end-indexed compiled [string range]. Thanks to Emiliano Gavilan for diagnosis and fix.

From: "[email-masked]" <dkf>
Date: Mon, 19 Nov 2012 22:08:35 +0000

---
 ChangeLog             |  6 ++++++
 generic/tclExecute.c  |  3 ---
 tests/lrange.test     | 14 +++++++++++++-
 tests/stringComp.test | 14 +++++++++++---
 4 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5c16eaa..70234e4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-11-19  Donal K. Fellows  <[email-masked]>
+
+	* generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected
+	implementation of bounds restriction for end-indexed compiled [string
+	range]. Thanks to Emiliano Gavilan for diagnosis and fix.
+
 2012-11-15  Jan Nijtmans  <[email-masked]>
 
 	IMPLEMENTATION OF TIP#416
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cf8f9e7..2b5f713 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4962,9 +4962,6 @@ TEBCresume(
 	}
 	if (toIdx < -1) {
 	    toIdx += 1 + length;
-	    if (toIdx < 0) {
-		toIdx = 0;
-	    }
 	} else if (toIdx >= length) {
 	    toIdx = length - 1;
 	}
diff --git a/tests/lrange.test b/tests/lrange.test
index 6c81872..17a757e 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -15,7 +15,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test lrange-1.1 {range of list elements} {
     lrange {a b c d} 1 2
 } {b c}
@@ -61,9 +61,11 @@ test lrange-1.14 {range of list elements} {
 test lrange-1.15 {range of list elements} {
     concat \"[lrange {a b \{\   	} 0 2]"
 } {"a b \{\ "}
+# emacs highlighting bug workaround --> "
 test lrange-1.16 {list element quoting} {
     lrange {[append a .b]} 0 end    
 } {{[append} a .b\]}
+
 test lrange-2.1 {error conditions} {
     list [catch {lrange a b} msg] $msg
 } {1 {wrong # args: should be "lrange list first last"}}
@@ -83,6 +85,16 @@ test lrange-2.6 {error conditions} {
     list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
 } {1 {unmatched open brace in list}}
 
+test lrange-3.1 {Bug 3588366: end-offsets before start} {
+    apply {l {
+	lrange $l 0 end-5
+    }} {1 2 3 4 5}
+} {}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 56fb69d..9e00ce7 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -26,7 +26,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Some tests require the testobj command
 
 testConstraint testobj [expr {[info commands testobj] != {}}]
-
+
 test stringComp-1.1 {error conditions} {
     proc foo {} {string gorp a b}
     list [catch {foo} msg] $msg
@@ -677,7 +677,11 @@ test stringComp-11.54 {string match, failure} {
 } {0 1 1 1 0 0}
 
 ## string range
-## not yet bc
+test stringComp-12.1 {Bug 3588366: end-offsets before start} {
+    apply {s {
+	string range $s 0 end-5
+    }} 12345
+} {}
 
 ## string repeat
 ## not yet bc
@@ -699,8 +703,12 @@ test stringComp-11.54 {string match, failure} {
 
 ## string word*
 ## not yet bc
-
+
 # cleanup
 catch {rename foo {}}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
-- 
cgit v0.12