summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-02-23 21:08:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-02-23 21:08:11 (GMT)
commit9e0ab0841248c6ba0cf49036de9005c8d0120a28 (patch)
treef073644653dd2240e0cbd30ddf34ab71e3f61c64
parent7e1cb76f0617c08d56ca78ebe894a0e1f3d9d532 (diff)
downloadtcl-9e0ab0841248c6ba0cf49036de9005c8d0120a28.zip
tcl-9e0ab0841248c6ba0cf49036de9005c8d0120a28.tar.gz
tcl-9e0ab0841248c6ba0cf49036de9005c8d0120a28.tar.bz2
Add tests relating to bug 1115587. The bug itself still exists at this point.
-rw-r--r--ChangeLog7
-rw-r--r--tests/reg.test63
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 <dkf@users.sf.net>
+
+ * 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 <nijtmans@users.sf.net>
- * 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 <dkf@users.sf.net>
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: