summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-11-19 22:08:35 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-11-19 22:08:35 (GMT)
commit094f23c172acca8f32b0888cd536f01fc1daab1b (patch)
tree9790caf5f3e563afb49a9b98f35fe6c8f92fb8df
parent2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95 (diff)
downloadtcl-094f23c172acca8f32b0888cd536f01fc1daab1b.zip
tcl-094f23c172acca8f32b0888cd536f01fc1daab1b.tar.gz
tcl-094f23c172acca8f32b0888cd536f01fc1daab1b.tar.bz2
[Bug 3588366]: Corrected implementation of bounds restriction for end-indexed
compiled [string range]. Thanks to Emiliano Gavilan for diagnosis and fix.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c3
-rw-r--r--tests/lrange.test14
-rw-r--r--tests/stringComp.test14
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 <dkf@users.sf.net>
+
+ * 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 <nijtmans@users.sf.net>
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: