From d8635a48cf1f669a2c8103dacc8a93e3e3269b87 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 29 Nov 2005 10:32:30 +0000 Subject: Fix [Bug 1366683] --- ChangeLog | 7 +++++++ generic/tclCmdIL.c | 21 ++++++++++++++++++--- tests/lsearch.test | 6 +++++- 3 files changed, 30 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2e7da5d..0e98fdc 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 Donal K. Fellows * win/tclWinSock.c (CreateSocket): Applied [Patch 1353853] to prevent diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index f38011b..7a232a6 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,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.47.2.7 2005/10/23 22:01:29 msofer Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.47.2.8 2005/11/29 10:32:31 dkf Exp $ */ #include "tclInt.h" @@ -3017,11 +3017,26 @@ 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); 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); + } + + if (regexp == NULL) { if (startPtr) { Tcl_DecrRefCount(startPtr); } diff --git a/tests/lsearch.test b/tests/lsearch.test index 96ff415..47d4ffc 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.10.2.1 2003/03/27 13:11:16 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.10.2.2 2005/11/29 10:32:31 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -349,6 +349,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 # cleanup catch {unset res} -- cgit v0.12