diff options
author | hobbs <hobbs> | 2008-08-21 23:42:22 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2008-08-21 23:42:22 (GMT) |
commit | 2e1f9a90e2bb9a21b3ccc70970b71384199885e1 (patch) | |
tree | 6335082b878c14b1a71639837969408d8b9c7870 | |
parent | 4ad1d554a92681b3d78876608ad0671c76098978 (diff) | |
download | tcl-2e1f9a90e2bb9a21b3ccc70970b71384199885e1.zip tcl-2e1f9a90e2bb9a21b3ccc70970b71384199885e1.tar.gz tcl-2e1f9a90e2bb9a21b3ccc70970b71384199885e1.tar.bz2 |
really fix translation to escape glob-sensitive chars
-rw-r--r-- | generic/tclUtil.c | 37 | ||||
-rw-r--r-- | tests/regexpComp.test | 21 |
2 files changed, 45 insertions, 13 deletions
diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9464cd5..ec0f2ff 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.97.2.2 2008/08/21 23:19:05 hobbs Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.97.2.3 2008/08/21 23:42:22 hobbs Exp $ */ #include "tclInt.h" @@ -3274,23 +3274,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 @@ -3305,7 +3316,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 f38062d..0fbed97 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 { |