From a0d41bb652b196bbd0c803b2b99e9ea7e90ea72d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 12 Feb 2008 10:27:26 +0000 Subject: Fix [Bug 1891827] --- ChangeLog | 25 ++++++++++++++----------- generic/tclCompCmds.c | 14 +++++++++----- tests/switch.test | 8 +++++++- 3 files changed, 30 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index e42a3f8..82ab3ea 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,19 +1,22 @@ 2008-02-12 Donal K. Fellows + * generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for + * tests/switch.test (switch-10.15): handling -nocase compilation; the + -exact -nocase option cannot be compiled currently. [Bug 1891827] + * unix/README: Documented missing configure flags. [Bug 1799011] 2008-02-06 Kevin B. Kenny - * doc/clock.n (%N): + * doc/clock.n (%N): Corrected an error in the explanation of the %N + format group. * generic/tclClock.c (ClockParseformatargsObjCmd): * library/clock.tcl (::tcl::clock::format): * tests/clock.test (clock-1.0, clock-1.4): - Performance enhancements in [clock format] (moving - the analysis of $args into C code, holding on to - Tcl_Objs with resolved command names, [lassign] - in place of [foreach], avoiding [namespace which] - for command resolution). Corrected an error in the - explanation of the %N format group. + Performance enhancements in [clock format] (moving the analysis of + $args into C code, holding on to Tcl_Objs with resolved command names, + [lassign] in place of [foreach], avoiding [namespace which] for + command resolution). 2008-02-04 Don Porter @@ -33,8 +36,8 @@ 2008-02-04 Miguel Sofer - * generic/tclExecute.c (INST_CONCAT1): fix optimisation for - in-place concatenation (was going over String type) + * generic/tclExecute.c (INST_CONCAT1): fix optimisation for in-place + concatenation (was going over String type) 2008-02-02 Daniel Steffen @@ -45,8 +48,8 @@ 2008-01-30 Miguel Sofer - * generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], - thanks go to an00na + * generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], thanks go + to an00na 2008-01-30 Donal K. Fellows diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5b5cd93..82edcd7 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.140 2008/01/23 19:41:27 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.141 2008/02/12 10:27:26 dkf Exp $ */ #include "tclInt.h" @@ -3967,7 +3967,7 @@ TclCompileSwitchCmd( } tokenPtr = TokenAfter(tokenPtr); numWords--; - if (noCase && (mode != Switch_Exact)) { + if (noCase && (mode == Switch_Exact)) { /* * Can't compile this case; no opcode for case-insensitive equality! */ @@ -4376,6 +4376,7 @@ TclCompileSwitchCmd( foundDefault = 0; for (i=0 ; icurrStackDepth = savedStackDepth + 1; if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 || memcmp(bodyToken[numWords-2]->start, "default", 7)) { @@ -4400,6 +4401,7 @@ TclCompileSwitchCmd( /* * Keep in sync with TclCompileRegexpCmd. */ + if (bodyToken[i]->type == TCL_TOKEN_TEXT) { Tcl_DString ds; @@ -4439,13 +4441,15 @@ TclCompileSwitchCmd( } } else { /* - * Pass correct RE compile flags. We use only Int1 + * 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 backrefs + * pass. Don't use TCL_REG_NOSUB as we may have backrefs * or capture vars. */ + int cflags = TCL_REG_ADVANCED - | (noCase ? TCL_REG_NOCASE : 0); + | (noCase ? TCL_REG_NOCASE : 0); + TclEmitInstInt1(INST_REGEXP, cflags, envPtr); } break; diff --git a/tests/switch.test b/tests/switch.test index 8b1a4a5..45f494f 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.19 2007/12/19 21:09:38 hobbs Exp $ +# RCS: @(#) $Id: switch.test,v 1.20 2008/02/12 10:27:27 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -501,6 +501,12 @@ rename cswtest-exact {} rename iswtest-exact {} rename cswtest2-exact {} rename iswtest2-exact {} +# Bug 1891827 +test switch-10.15 {(not) compiled exact nocase regression} { + apply {{} { + switch -nocase -- A { a {return yes} default {return no} } + }} +} yes # Added due to TIP#75 test switch-11.1 {regexp matching with -matchvar} { -- cgit v0.12