Tcl Source Code

Check-in [6990132056]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add tests relating to bug 1115587. The bug itself still exists at this point.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 69901320565589b288506f62c2ffe0fe917e9e8e
User & Date: dkf 2012-02-23 21:08:11
Context
2012-02-29
21:34
[Bug 3466099] BOM in Unicode check-in: ca6c454087 user: jan.nijtmans tags: core-8-5-branch
2012-02-23
21:10
Add tests relating to bug 1115587. The bug itself still exists at this point. check-in: fc453fd101 user: dkf tags: trunk
21:08
Add tests relating to bug 1115587. The bug itself still exists at this point. check-in: 6990132056 user: dkf tags: core-8-5-branch
2012-02-17
21:17
[Bug 2233954] AIX: compile error, but don't do that for _WIN32 (doesn't work in VS10) check-in: fa683cad00 user: jan.nijtmans tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7
8
9
10





2012-02-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c: [Bug 2233954] AIX: compile error
	* unix/tclUnixPort.h:

2012-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictForCmd): [Bug 3487626]: Fix
	crash in compilation of [dict for] when its implementation command is
	used directly rather than through the ensemble.
>
>
>
>
>


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2012-02-23  Donal K. Fellows  <[email protected]>

	* 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  <[email protected]>

	* generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error
	* unix/tclUnixPort.h:

2012-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictForCmd): [Bug 3487626]: Fix
	crash in compilation of [dict for] when its implementation command is
	used directly rather than through the ensemble.

Changes to tests/reg.test.

169
170
171
172
173
174
175




















176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
	foreach f [split $infonameorder ""] {
	    if {[string match *$f* $fl]} {
		lappend ret $infonames($f)
	    }
	}
	return $ret
    }





















    # 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]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    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 f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







<
<








|
<
<
<
<
<
<
<
<
<
<
<







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202


203
204
205
206
207
208
209
210
211











212
213
214
215
216
217
218
	foreach f [split $infonameorder ""] {
	    if {[string match *$f* $fl]} {
		lappend ret $infonames($f)
	    }
	}
	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} {


	# if &, test as both BRE and ARE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]












	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectError "$testid ARE" ${f}  $re $err
	    expectError "$testid BRE" ${f}b $re $err
	    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 cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # match failure expected
    proc expectNomatch {testid flags re target args} {

	# if &, test as both ARE and BRE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    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 f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps







|
<
<
<
<
<
<









>








|
<
<
<
<
<
<







255
256
257
258
259
260
261
262






263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281






282
283
284
285
286
287
288
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectError "$testid ARE" ${f}  $re $err
	    expectError "$testid BRE" ${f}b $re $err
	    return
	}

	set constraints [TestConstraints $flags]







	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # 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]
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]







	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0
    }
}
namespace import RETest::*

######## the tests themselves ########

# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
::tcltest::test reg-0.1 "regexp error reporting" {
    list [catch {regexp (*) ign} msg] $msg







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0
    }
}
namespace import RETest::*

######## the tests themselves ########

# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
::tcltest::test reg-0.1 "regexp error reporting" {
    list [catch {regexp (*) ign} msg] $msg
656
657
658
659
660
661
662



663
664
665
666
667
668
669
expectNomatch	14.14 QRP	"a(\[bc])\\1{3,4}"	abbb
expectMatch	14.15 RP	{a([bc])\1*}	abbb	abbb	b
expectMatch	14.16 RP	{a([bc])\1*}	ab	ab	b
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





doing 15 "octal escapes vs back references"
# initial zero is always octal
expectMatch	15.1  MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	15.2  MP	"a\\0070b"	"a\0070b"	"a\0070b"
expectMatch	15.3  MP	"a\\07b"	"a\007b"	"a\007b"







>
>
>







652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
expectNomatch	14.14 QRP	"a(\[bc])\\1{3,4}"	abbb
expectMatch	14.15 RP	{a([bc])\1*}	abbb	abbb	b
expectMatch	14.16 RP	{a([bc])\1*}	ab	ab	b
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"
# initial zero is always octal
expectMatch	15.1  MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	15.2  MP	"a\\0070b"	"a\0070b"	"a\0070b"
expectMatch	15.3  MP	"a\\07b"	"a\007b"	"a\007b"
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075




test reg-33.13 {Bug 1810264 - infinite loop} {
    regexp {($|^)*} {x}
} 1
# Some environments have small default stack sizes. [Bug 1905562]
test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
    regexp {(x{200}){200}$y} {x}
} 0

# cleanup
::tcltest::cleanupTests
return











|



>
>
>
>
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
test reg-33.13 {Bug 1810264 - infinite loop} {
    regexp {($|^)*} {x}
} 1
# Some environments have small default stack sizes. [Bug 1905562]
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: