summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-11-29 10:32:56 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-11-29 10:32:56 (GMT)
commitee5f76eeacd881cb235705efa89282157cceeed4 (patch)
tree2d0b4b24895eebe7b99a38c593b4633376d1807a
parentc530770762d3eff1b6450ecedfc1cc3e844fb73b (diff)
downloadtcl-ee5f76eeacd881cb235705efa89282157cceeed4.zip
tcl-ee5f76eeacd881cb235705efa89282157cceeed4.tar.gz
tcl-ee5f76eeacd881cb235705efa89282157cceeed4.tar.bz2
Fix [Bug 1366683]
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclCmdIL.c20
-rw-r--r--tests/lsearch.test6
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 <donal.k.fellows@manchester.ac.uk>
+
+ * 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 <kennykb@acm.org>
* 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 <das@users.sourceforge.net>
* 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 <kennykb@acm.org>
@@ -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 <andreask@activestate.com>
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