diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/regcomp.c | 8 | ||||
| -rw-r--r-- | generic/tclTest.c | 26 | ||||
| -rw-r--r-- | tests/reg.test | 137 |
4 files changed, 170 insertions, 7 deletions
@@ -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 |