diff options
| -rw-r--r-- | generic/tclRegexp.c | 15 | ||||
| -rw-r--r-- | tests/set-old.test | 7 |
2 files changed, 18 insertions, 4 deletions
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index ea25d4b..cfe6388 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -502,10 +502,17 @@ Tcl_RegExpMatchObj( { Tcl_RegExp re; - re = Tcl_GetRegExpFromObj(interp, patternObj, - TCL_REG_ADVANCED | TCL_REG_NOSUB); - if (re == NULL) { - return -1; + /* + * For performance reasons, first try compiling the RE without support for + * subexpressions. On failure, try again without TCL_REG_NOSUB in case the + * RE has backreferences in it. Closely related to [Bug 1366683]. If this + * still fails, an error message will be left in the interpreter. + */ + + if (!(re = Tcl_GetRegExpFromObj(interp, patternObj, + TCL_REG_ADVANCED | TCL_REG_NOSUB)) + && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) { + return -1; } return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, 0 /* nmatches */, 0 /* flags */); diff --git a/tests/set-old.test b/tests/set-old.test index 1c68f91..6138ed8 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -652,6 +652,13 @@ test set-old-8.52 {array command, array names -regexp on regexp pattern} { set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} +test set-old-8.52.1 {array command, array names -regexp, backrefs} { + catch {unset a} + set a(1*2) 1 + set a(12) 1 + set a(11) 1 + list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg +} {0 11} test set-old-8.53 {array command, array names -regexp} { catch {unset a} set a(-glob) 1 |