From 9e0ab0841248c6ba0cf49036de9005c8d0120a28 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 23 Feb 2012 21:08:11 +0000 Subject: Add tests relating to bug 1115587. The bug itself still exists at this point. --- ChangeLog | 7 ++++++- tests/reg.test | 63 ++++++++++++++++++++++++++++++---------------------------- 2 files changed, 39 insertions(+), 31 deletions(-) diff --git a/ChangeLog b/ChangeLog index 48b6f81..e603d00 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,11 @@ +2012-02-23 Donal K. Fellows + + * tests/reg.test (14.21-23): Add tests relating to bug 1115587. Actual + bug is characterised by test marked with 'knownBug'. + 2012-02-17 Jan Nijtmans - * generic/tclIOUtil.c: [Bug 2233954] AIX: compile error + * generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error * unix/tclUnixPort.h: 2012-02-15 Donal K. Fellows diff --git a/tests/reg.test b/tests/reg.test index d92339f..0ebfa11 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -174,14 +174,32 @@ namespace eval RETest { return $ret } + # Share the generation of the list of test constraints so it is + # done the same on all routes. + proc TestConstraints {flags} { + set constraints [list testregexp] + + variable regBug + if {$regBug} { + # This will trigger registration as a skipped test + lappend constraints knownBug + } + + # Tcl locale stuff doesn't do the ch/xy test fakery yet + if {[string match *+* $flags]} { + # This will trigger registration as a skipped test + lappend constraints localeRegexp + } + + return $constraints + } + # match expected, internal routine that does the work # parameters like the "real" routines except they don't have "opts", # which is a possibly-empty list of switches for the regexp match attempt # The ! flag is used to indicate expected match failure (for REG_EXPECT, # which wants argument testing even in the event of failure). proc MatchExpected {opts testid flags re target args} { - variable regBug - # if &, test as both BRE and ARE if {[string match *&* $flags]} { set f [string map {& {}} $flags] @@ -190,18 +208,7 @@ namespace eval RETest { return } - set constraints [list testregexp] - - if {$regBug} { - # This will register as a skipped test - lappend constraints knownBug - } - - # Tcl locale stuff doesn't do the ch/xy test fakery yet - if {[string match *+* $flags]} { - # This will register as a skipped test - lappend constraints localeRegexp - } + set constraints [TestConstraints $flags] set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] @@ -252,13 +259,7 @@ namespace eval RETest { return } - set constraints [list testregexp] - - # Tcl locale stuff doesn't do the ch/xy test fakery yet - if {[string match *+* $flags]} { - # This will register as a skipped test - lappend constraints localeRegexp - } + set constraints [TestConstraints $flags] set cmd [list testregexp -about {*}[TestFlags $flags] $re] ::tcltest::test [TestNum $testid error] [TestDesc $testid error] \ @@ -268,6 +269,7 @@ namespace eval RETest { # match failure expected proc expectNomatch {testid flags re target args} { + variable regBug # if &, test as both ARE and BRE if {[string match *&* $flags]} { set f [string map {& {}} $flags] @@ -276,13 +278,7 @@ namespace eval RETest { return } - set constraints [list testregexp] - - # Tcl locale stuff doesn't do the ch/xy test fakery yet - if {[string match *+* $flags]} { - # This will register as a skipped test - lappend constraints localeRegexp - } + set constraints [TestConstraints $flags] set f [TestFlags $flags] set infoflags [TestInfoFlags $flags] @@ -331,7 +327,7 @@ namespace eval RETest { } } namespace import RETest::* - + ######## the tests themselves ######## # support functions and preliminary misc. @@ -660,6 +656,9 @@ expectMatch 14.17 RP {a([bc])(\1*)} ab ab b "" expectError 14.18 - {a((b)\1)} ESUBREG expectError 14.19 - {a(b)c\2} ESUBREG expectMatch 14.20 bR {a\(b*\)c\1} abbcbb abbcbb bb +expectMatch 14.21 RP {^([bc])\1*$} bbb bbb b +expectMatch 14.22 RP {^([bc])\1*$} ccc ccc c +knownBug expectNomatch 14.23 R {^([bc])\1*$} bcb doing 15 "octal escapes vs back references" @@ -1069,7 +1068,11 @@ test reg-33.13 {Bug 1810264 - infinite loop} { test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable { regexp {(x{200}){200}$y} {x} } 0 - + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12