summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-17 16:40:38 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-17 16:40:38 (GMT)
commit70e6283bef9733ca12935627fda82f732e5cabd9 (patch)
tree9189e098fb6bd51d8f37b37a01587f65375cd5b6
parenteb98b2c7785409192628ad59475e3581ca2b901b (diff)
downloadtcl-70e6283bef9733ca12935627fda82f732e5cabd9.zip
tcl-70e6283bef9733ca12935627fda82f732e5cabd9.tar.gz
tcl-70e6283bef9733ca12935627fda82f732e5cabd9.tar.bz2
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
resulting indexes from -indexvar option to be usable with [string range]; this was always the intention (and is consistent with [regexp -indices] too). ***POTENTIAL INCOMPATIBILITY*** Uses of [switch -regexp -indexvar] that previously compensated for the wrong offsets (by subtracting 1 from the end indices) now do not need to do so as the value is correct.
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--tests/switch.test22
3 files changed, 31 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 5850670..6ea446c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2012-05-17 Donal K. Fellows <dkf@users.sf.net>
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
+ resulting indexes from -indexvar option to be usable with [string
+ range]; this was always the intention (and is consistent with [regexp
+ -indices] too).
+ ***POTENTIAL INCOMPATIBILITY***
+ Uses of [switch -regexp -indexvar] that previously compensated for the
+ wrong offsets (by subtracting 1 from the end indices) now do not need
+ to do so as the value is correct.
+
* library/safe.tcl (safe::InterpInit): Ensure that the module path is
constructed in the correct order.
(safe::AliasGlob): [Bug 2964715]: More extensive handling of what
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 531e2b1..0ad77aa 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3679,8 +3679,12 @@ Tcl_SwitchObjCmd(
if (indexVarObj != NULL) {
Tcl_Obj *rangeObjAry[2];
- rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
- rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
+ if (info.matches[j].end > 0) {
+ rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
+ rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
+ } else {
+ rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
+ }
/*
* Never fails; the object is always clean at this point.
diff --git a/tests/switch.test b/tests/switch.test
index 5ee7216..f04f636 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -536,7 +536,7 @@ test switch-11.6 {-matchvar unwritable} {
test switch-12.1 {regexp matching with -indexvar} {
switch -regexp -indexvar x -- abc {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
test switch-12.2 {regexp matching with -indexvar} {
set x GOOD
switch -regexp -indexvar x -- abc {.(.).. {list $x z}}
@@ -544,7 +544,7 @@ test switch-12.2 {regexp matching with -indexvar} {
} GOOD
test switch-12.3 {regexp matching with -indexvar} {
switch -regexp -indexvar x -- "a b c" {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
test switch-12.4 {regexp matching with -indexvar} {
set x BAD
switch -regexp -indexvar x -- "a b c" {
@@ -560,22 +560,32 @@ test switch-12.6 {-indexvar unwritable} {
set x {}
list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {can't set "x(x)": variable isn't array}}
+test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
+ set str abcdef
+ switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
+} abc
+test switch-12.8 {-indexvar and matched empty strings} {
+ switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
+} {{0 2} {3 2}}
+test switch-12.9 {-indexvar and unmatched strings} {
+ switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
+} {{0 2} {-1 -1}}
test switch-13.1 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
. {list $x $y}
}
-} {{{0 1}} a}
+} {{{0 0}} a}
test switch-13.2 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
.$ {list $x $y}
}
-} {{{2 3}} c}
+} {{{2 2}} c}
test switch-13.3 {-indexvar -matchvar combinations} {
switch -regexp -indexvar x -matchvar y abc {
(.)(.)(.) {list $x $y}
}
-} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}}
+} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}}
test switch-13.4 {-indexvar -matchvar combinations} {
set x -
set y -
@@ -597,7 +607,7 @@ test switch-13.6 {-indexvar -matchvar combinations} {
list [catch {
switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
} msg] $x $y $msg
-} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
+} {1 {{0 0}} - {can't set "y(y)": variable isn't array}}
test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
switch -regexp -- 0 {