From ee5f76eeacd881cb235705efa89282157cceeed4 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 29 Nov 2005 10:32:56 +0000 Subject: Fix [Bug 1366683] --- ChangeLog | 13 ++++++++++--- generic/tclCmdIL.c | 20 +++++++++++++++++--- tests/lsearch.test | 6 +++++- 3 files changed, 32 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index c5ccd02..83bd957 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2005-11-29 Donal K. Fellows + + * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Allow [lsearch -regexp] to + process REs that contain backreferences. This expensive mode of + operation is only used if the RE would otherwise cause a compilation + failure. [Bug 1366683] + 2005-11-28 Kevin Kenny * tools/tclZIC.tcl (convertTimeOfDay): Corrected a typo that @@ -9,7 +16,7 @@ * library/tzdata: Updated to Olson's 'tzdata2005o' (changes for Cuba, Nicaragua, Jordan, and Georgia) and regenerated. Thanks to Paul Mackerras for reporting this problem. - + 2005-11-27 Daniel Steffen * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(), @@ -150,7 +157,7 @@ * tests/trace.test (trace-34.5): [Bug 1047286], added a second test illustrating the role of "ns in callStack" in the ns's - visibility during deletion traces. + visibility during deletion traces. 2005-11-18 Kevin B. Kenny @@ -168,7 +175,7 @@ * generic/tclObj.c (GetBignumFromObj): replace NULL with tclEmptyStringRep to stop memcpy from complaining in a debug build (the corresponding branch is eliminated by the optimiser - otherwise). + otherwise). 2005-11-18 Andreas Kupries diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 12c3e77..4c83b5f 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.84 2005/11/04 22:38:38 msofer Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.85 2005/11/29 10:32:56 dkf Exp $ */ #include "tclInt.h" @@ -3394,13 +3394,27 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) if ((enum modes) mode == REGEXP) { /* * We can shimmer regexp/list if listv[i] == pattern, so get the - * regexp rep before the list rep. + * regexp rep before the list rep. First time round, omit the interp + * and hope that the compilation will succeed. If it fails, we'll + * recompile in "expensive" mode with a place to put error messages. */ - regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1], + regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1], TCL_REG_ADVANCED | TCL_REG_NOSUB | (noCase ? TCL_REG_NOCASE : 0)); if (regexp == NULL) { + /* + * Failed to compile the RE. Try again without the TCL_REG_NOSUB + * flag in case the RE had sub-expressions in it [Bug 1366683]. + * If this fails, an error message will be left in the + * interpreter. + */ + + regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1], + TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0)); + } + + if (regexp == NULL) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } diff --git a/tests/lsearch.test b/tests/lsearch.test index 0155bdd..a54c1a0 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.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: lsearch.test,v 1.16 2005/06/01 11:00:35 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.17 2005/11/29 10:32:56 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -382,6 +382,10 @@ test lsearch-16.1 {lsearch -regexp shared object} { set str a lsearch -regexp $str $str } 0 +# Bug 1366683 +test lsearch-16.2 {lsearch -regexp allows internal backrefs} { + lsearch -regexp {a aa b} {(.)\1} +} 1 test lsearch-17.1 {lsearch -index option, basic functionality} { lsearch -index 1 {{a c} {a b} {a a}} a -- cgit v0.12