summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclUtil.c37
-rw-r--r--tests/regexpComp.test21
2 files changed, 45 insertions, 13 deletions
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5f20af1..605951c 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -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: tclUtil.c,v 1.100 2008/08/21 23:19:49 hobbs Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.101 2008/08/21 23:42:13 hobbs Exp $
*/
#include "tclInt.h"
@@ -3275,23 +3275,34 @@ TclReToGlob(
Tcl_DStringInit(dsPtr);
/*
- * "***=xxx" == "*xxx*"
+ * Write to the ds directly without the function overhead.
+ * An equivalent glob pattern can be no more than reStrLen+2 in size.
*/
- if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
- Tcl_DStringAppend(dsPtr, "*", 1);
- Tcl_DStringAppend(dsPtr, reStr + 4, reStrLen - 4);
- Tcl_DStringAppend(dsPtr, "*", 1);
- return TCL_OK;
- }
+ Tcl_DStringSetLength(dsPtr, reStrLen + 2);
+ dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
/*
- * Write to the ds directly without the function overhead.
- * An equivalent glob pattern can be no more than reStrLen+2 in size.
+ * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
*/
- Tcl_DStringSetLength(dsPtr, reStrLen + 2);
- dsStrStart = Tcl_DStringValue(dsPtr);
+ if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
+ *dsStr++ = '*';
+ for (p = reStr + 4; p < strEnd; p++) {
+ switch (*p) {
+ case '\\': case '*': case '[': case ']': case '?':
+ /* Only add \ where necessary for glob */
+ *dsStr++ = '\\';
+ /* fall through */
+ default:
+ *dsStr++ = *p;
+ break;
+ }
+ }
+ *dsStr++ = '*';
+ Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
+ return TCL_OK;
+ }
/*
* Check for anchored REs (ie ^foo$), so we can use string equal if
@@ -3306,7 +3317,7 @@ TclReToGlob(
p = reStr;
anchorRight = 0;
lastIsStar = 0;
- dsStr = dsStrStart;
+
if (*p == '^') {
anchorLeft = 1;
p++;
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index eeba434..aaae977 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -105,6 +105,27 @@ test regexp-1.13 {regexp ***= metasyntax} {
regexp -- $re $string
}
} 0
+test regexp-1.14 {regexp ***= metasyntax} {
+ evalInProc {
+ set string "aeiou"
+ set re "***=e*o"
+ regexp -- $re $string
+ }
+} 0
+test regexp-1.15 {regexp ***= metasyntax} {
+ evalInProc {
+ set string "ae*ou"
+ set re "***=e*o"
+ regexp -- $re $string
+ }
+} 1
+test regexp-1.16 {regexp ***= metasyntax} {
+ evalInProc {
+ set string {ae*[o]?ua}
+ set re {***=e*[o]?u}
+ regexp -- $re $string
+ }
+} 1
test regexpComp-2.1 {getting substrings back from regexp} {
evalInProc {