summaryrefslogtreecommitdiffstats
path: root/tests/reg.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-02-23 21:10:08 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-02-23 21:10:08 (GMT)
commitf3bdd208ac10cfe9a475b0689677acd542debee2 (patch)
treefab52bff0daa0ff0e2c59e63bc82678e64de6b1c /tests/reg.test
parentf40cc098f4cfadea6aa0a597de897558fc92e427 (diff)
parent9e0ab0841248c6ba0cf49036de9005c8d0120a28 (diff)
downloadtcl-f3bdd208ac10cfe9a475b0689677acd542debee2.zip
tcl-f3bdd208ac10cfe9a475b0689677acd542debee2.tar.gz
tcl-f3bdd208ac10cfe9a475b0689677acd542debee2.tar.bz2
Add tests relating to bug 1115587. The bug itself still exists at this point.
Diffstat (limited to 'tests/reg.test')
-rw-r--r--tests/reg.test63
1 files changed, 33 insertions, 30 deletions
diff --git a/tests/reg.test b/tests/reg.test
index ca6cdd1..abfc9ca 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.
@@ -668,6 +664,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"
@@ -1078,7 +1077,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: