summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-11-17 18:12:07 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-11-17 18:12:07 (GMT)
commitfa21483afb1b8a95e33287eaa28f20f0bb319d40 (patch)
treee29fd69d2797dd44088bff0bc55f109b06ea7179
parent8a337db141701521a51b0fbdeed2ec76f4557129 (diff)
downloadtcl-fa21483afb1b8a95e33287eaa28f20f0bb319d40.zip
tcl-fa21483afb1b8a95e33287eaa28f20f0bb319d40.tar.gz
tcl-fa21483afb1b8a95e33287eaa28f20f0bb319d40.tar.bz2
* generic/regcomp.c: Backported regexp bug fixes and tests. Thanks
* generic/tclTest.c: to Pavel Goran and Vince Darley. * tests/reg.test: [Bugs 230589, 504785, 505048, 703709, 840258]
-rw-r--r--ChangeLog6
-rw-r--r--generic/regcomp.c8
-rw-r--r--generic/tclTest.c26
-rw-r--r--tests/reg.test137
4 files changed, 170 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 822adbf..b650269 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-11-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/regcomp.c: Backported regexp bug fixes and tests. Thanks
+ * generic/tclTest.c: to Pavel Goran and Vince Darley.
+ * tests/reg.test: [Bugs 230589, 504785, 505048, 703709, 840258]
+
2003-11-12 Jeff Hobbs <jeffh@ActiveState.com>
* tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 4aba629..2a7fd6e 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -553,8 +553,12 @@ struct nfa *nfa;
if (b->from != pre)
break;
if (b != NULL) { /* must be split */
- s->tmp = slist;
- slist = s;
+ if (s->tmp == NULL) { /* if not already in the list */
+ /* (fixes bugs 505048, 230589, */
+ /* 840258, 504785) */
+ s->tmp = slist;
+ slist = s;
+ }
}
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 3a23941..835c602 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.62.2.4 2003/10/31 13:33:40 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.62.2.5 2003/11/17 18:12:08 dgp Exp $
*/
#define TCL_TEST
@@ -3339,12 +3339,26 @@ TestregexpObjCmd(dummy, interp, objc, objv)
char *varName;
CONST char *value;
int start, end;
- char info[TCL_INTEGER_SPACE * 2];
+ char resinfo[TCL_INTEGER_SPACE * 2];
varName = Tcl_GetString(objv[2]);
TclRegExpRangeUniChar(regExpr, -1, &start, &end);
- sprintf(info, "%d %d", start, end-1);
- value = Tcl_SetVar(interp, varName, info, 0);
+ sprintf(resinfo, "%d %d", start, end-1);
+ value = Tcl_SetVar(interp, varName, resinfo, 0);
+ if (value == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ varName, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (cflags & TCL_REG_CANMATCH) {
+ char *varName;
+ CONST char *value;
+ char resinfo[TCL_INTEGER_SPACE * 2];
+
+ Tcl_RegExpGetInfo(regExpr, &info);
+ varName = Tcl_GetString(objv[2]);
+ sprintf(resinfo, "%d", info.extendStart);
+ value = Tcl_SetVar(interp, varName, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
varName, "\"", (char *) NULL);
@@ -3463,6 +3477,10 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
cflags &= ~REG_ADVANCED;
break;
}
+ case 'c': {
+ cflags |= TCL_REG_CANMATCH;
+ break;
+ }
case 'e': {
cflags &= ~REG_ADVANCED;
cflags |= REG_EXTENDED;
diff --git a/tests/reg.test b/tests/reg.test
index a4f5bea..66c3768 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -9,7 +9,7 @@
#
# Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
#
-# RCS: @(#) $Id: reg.test,v 1.16.2.1 2003/10/06 14:30:06 dgp Exp $
+# RCS: @(#) $Id: reg.test,v 1.16.2.2 2003/11/17 18:12:09 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -995,6 +995,141 @@ test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} {
# Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!!
} {1 2 2 {}}
+test reg-32.1 {canmatch functionality -- at end} {
+ set pat {blah}
+ set line "asd asd"
+ # can match at the final d, if '%' follows
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 7}
+
+test reg-32.2 {canmatch functionality -- at end} {
+ set pat {s%$}
+ set line "asd asd"
+ # can only match after the end of the string
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 7}
+
+test reg-32.3 {canmatch functionality -- not last char} {
+ set pat {[^d]%$}
+ set line "asd asd"
+ # can only match after the end of the string
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 7}
+
+test reg-32.3.1 {canmatch functionality -- no match} {
+ set pat {\Zx}
+ set line "asd asd"
+ # can match the last char, if followed by x
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 -1}
+
+test reg-32.4 {canmatch functionality -- last char} {knownBug} {
+ set pat {.x}
+ set line "asd asd"
+ # can match the last char, if followed by x
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.4.1 {canmatch functionality -- last char} {knownBug} {
+ set pat {.x$}
+ set line "asd asd"
+ # can match the last char, if followed by x
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.5 {canmatch functionality -- last char} {knownBug} {
+ set pat {.[^d]x$}
+ set line "asd asd"
+ # can match the last char, if followed by not-d and x.
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.6 {canmatch functionality -- last char} {knownBug} {
+ set pat {[^a]%[^\r\n]*$}
+ set line "asd asd"
+ # can match at the final d, if '%' follows
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.7 {canmatch functionality -- last char} {knownBug} {
+ set pat {[^a]%$}
+ set line "asd asd"
+ # can match at the final d, if '%' follows
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.8 {canmatch functionality -- last char} {knownBug} {
+ set pat {[^x]%$}
+ set line "asd asd"
+ # can match at the final d, if '%' follows
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+test reg-32.9 {canmatch functionality -- more complex case} {knownBug} {
+ set pat {((\B\B|\Bh+line)[ \t]*|[^\B]%[^\r\n]*)$}
+ set line "asd asd"
+ # can match at the final d, if '%' follows
+ set res [testregexp -xflags -- c $pat $line resvar]
+ lappend res $resvar
+} {0 6}
+
+# Tests reg-33.*: Checks for bug fixes
+
+test reg-33.1 {Bug 230589} {
+ regexp {[ ]*(^|[^%])%V} "*%V2" m s
+} 1
+
+test reg-33.2 {Bug 504785} {
+ regexp -inline {([^_.]*)([^.]*)\.(..)(.).*} bbcos_001_c01.q1la
+} {bbcos_001_c01.q1la bbcos _001_c01 q1 l}
+
+test reg-33.3 {Bug 505048} {
+ regexp {\A\s*[^<]*\s*<([^>]+)>} a<a>
+} 1
+
+test reg-33.4 {Bug 505048} {
+ regexp {\A\s*([^b]*)b} ab
+} 1
+
+test reg-33.5 {Bug 505048} {
+ regexp {\A\s*[^b]*(b)} ab
+} 1
+
+test reg-33.6 {Bug 505048} {
+ regexp {\A(\s*)[^b]*(b)} ab
+} 1
+
+test reg-33.7 {Bug 505048} {
+ regexp {\A\s*[^b]*b} ab
+} 1
+
+test reg-33.8 {Bug 505048} {
+ regexp -inline {\A\s*[^b]*b} ab
+} ab
+
+test reg-33.9 {Bug 505048} {
+ regexp -indices -inline {\A\s*[^b]*b} ab
+} {{0 1}}
+
+test reg-33.10 {Bug 840258} {
+ regsub {(^|\n)+\.*b} \n.b {} tmp
+} 1
+
+test reg-33.11 {Bug 840258} {
+ regsub {(^|[\n\r]+)\.*\?<.*?(\n|\r)+} \
+ "TQ\r\n.?<5000267>Test already stopped\r\n" {} tmp
+} 1
+
# cleanup
::tcltest::cleanupTests
return