diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-19 22:08:35 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-11-19 22:08:35 (GMT) |
commit | 094f23c172acca8f32b0888cd536f01fc1daab1b (patch) | |
tree | 9790caf5f3e563afb49a9b98f35fe6c8f92fb8df | |
parent | 2bf2abcb4f1c88fbddc3ce4d5800c438851aaf95 (diff) | |
download | tcl-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-- | ChangeLog | 6 | ||||
-rw-r--r-- | generic/tclExecute.c | 3 | ||||
-rw-r--r-- | tests/lrange.test | 14 | ||||
-rw-r--r-- | tests/stringComp.test | 14 |
4 files changed, 30 insertions, 7 deletions
@@ -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: |