diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 16 | ||||
| -rw-r--r-- | tests/switch.test | 37 |
3 files changed, 57 insertions, 3 deletions
@@ -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 |