Fix [Bug 1366683]

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  <donal.k.fellows@man.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  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* 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}