summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2007-12-19 21:09:36 (GMT)
committerhobbs <hobbs>2007-12-19 21:09:36 (GMT)
commit4da80a825f1db31720e1a5b7022ea192e220bd43 (patch)
treee23be9f1dc637406b0a26d21fd28e86cebb4201f
parente634b97b2369aa89f9bf799d272c622fbf7553d6 (diff)
downloadtcl-4da80a825f1db31720e1a5b7022ea192e220bd43.zip
tcl-4da80a825f1db31720e1a5b7022ea192e220bd43.tar.gz
tcl-4da80a825f1db31720e1a5b7022ea192e220bd43.tar.bz2
* generic/tclCompCmds.c (TclCompileSwitchCmd): update switch -regexp
* tests/switch.test-14.*: compilation to pass the cflags to INST_REGEXP (changed on 12-07). Added tests for switch -regexp compilation (need more). [Bug 1854399]
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCompCmds.c16
-rw-r--r--tests/switch.test37
3 files changed, 57 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index 40ded062..b21252d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-12-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): update switch -regexp
+ * tests/switch.test-14.*: compilation to pass
+ the cflags to INST_REGEXP (changed on 12-07). Added tests for
+ switch -regexp compilation (need more). [Bug 1854399]
+
2007-12-18 Don Porter <dgp@users.sourceforge.net>
*** 8.5.0 TAGGED FOR RELEASE ***
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 50cc83b..7dbcc2a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.137 2007/12/13 15:23:15 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.138 2007/12/19 21:09:37 hobbs Exp $
*/
#include "tclInt.h"
@@ -3134,6 +3134,7 @@ TclCompileRegexpCmd(
/*
* Get the regexp string. If it is not a simple string or can't be
* converted to a glob pattern, push the word for the INST_REGEXP.
+ * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
*/
varTokenPtr = TokenAfter(varTokenPtr);
@@ -4397,6 +4398,9 @@ TclCompileSwitchCmd(
case Switch_Regexp: {
int simple = 0, exact = 0;
+ /*
+ * Keep in sync with TclCompileRegexpCmd.
+ */
if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
Tcl_DString ds;
@@ -4435,7 +4439,15 @@ TclCompileSwitchCmd(
TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
}
} else {
- TclEmitInstInt1(INST_REGEXP, noCase, envPtr);
+ /*
+ * Pass correct RE compile flags. We use only Int1
+ * (8-bit), but that handles all the flags we want to
+ * pass.
+ * Don't use TCL_REG_NOSUB as we may have capture vars.
+ */
+ int cflags = TCL_REG_ADVANCED
+ | (noCase ? TCL_REG_NOCASE : 0);
+ TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
}
break;
}
diff --git a/tests/switch.test b/tests/switch.test
index 3309bc5..8b1a4a5 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: switch.test,v 1.18 2007/12/13 15:26:07 dgp Exp $
+# RCS: @(#) $Id: switch.test,v 1.19 2007/12/19 21:09:38 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -595,6 +595,41 @@ test switch-13.6 {-indexvar -matchvar combinations} {
} msg] $x $y $msg
} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
+test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
+ switch -regexp -- 0 {
+ {[0-9]+} {return yes}
+ default {return no}
+ }
+ foo
+} yes
+test switch-14.2 {-regexp -- compilation [Bug 1854399]} {
+ proc foo {} {
+ switch -regexp -- 0 {
+ {[0-9]+} {return yes}
+ default {return no}
+ }
+ }
+ foo
+} yes
+test switch-14.3 {-regexp -- compilation [Bug 1854399]} {
+ proc foo {} {
+ switch -regexp -- 0 {
+ {\d+} {return yes}
+ default {return no}
+ }
+ }
+ foo
+} yes
+test switch-14.4 {-regexp -- compilation [Bug 1854399]} {
+ proc foo {} {
+ switch -regexp -- 0 {
+ {0} {return yes}
+ default {return no}
+ }
+ }
+ foo
+} yes
+
# cleanup
::tcltest::cleanupTests
return