* 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]

1 files changed, 136 insertions, 1 deletions

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