diff options
Diffstat (limited to 'tests/regexp.test')
| -rw-r--r-- | tests/regexp.test | 220 |
1 files changed, 197 insertions, 23 deletions
diff --git a/tests/regexp.test b/tests/regexp.test index c77e147..1b2bec9 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -10,15 +10,13 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: regexp.test,v 1.35 2010/02/11 11:14:22 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } -catch {unset foo} +unset -nocomplain foo testConstraint exec [llength [info commands exec]] @@ -121,6 +119,28 @@ test regexp-2.10 {getting substrings back from regexp} { set f2 {} list [regexp f\352te(b*)c eff\352tebbbbc foo f2] $foo $f2 } [list 1 f\352tebbbbc bbbb] +test regexp-2.11 {non-capturing subgroup} { + set foo {} + set f2 {} + list [regexp {str(?:a+)} straa foo f2] $foo $f2 +} [list 1 straa {}] +test regexp-2.12 {non-capturing subgroup with -inline} { + regexp -inline {str(?:a+)} straa +} {straa} +test regexp-2.13 {non-capturing and capturing subgroups} { + set foo {} + set f2 {} + set f3 {} + list [regexp {str(?:a+)(c+)} straacc foo f2 f3] $foo $f2 $f3 +} [list 1 straacc cc {}] +test regexp-2.14 {non-capturing and capturing subgroups} { + regexp -inline {str(?:a+)(c+)} straacc +} {straacc cc} +test regexp-2.15 {getting substrings back from regexp} { + set foo NA + set f2 NA + list [regexp {str(?:a+)} straa foo f2] $foo $f2 +} [list 1 straa {}] test regexp-3.1 {-indices option to regexp} { set foo {} @@ -176,7 +196,7 @@ set x $x$x$x$x$x$x$x$x$x$x$x$x test regexp-4.4 {case conversion in regexp} { list [regexp -nocase $x $x foo] $foo } "1 $x" -catch {unset x} +unset -nocomplain x test regexp-5.1 {exercise cache of compiled expressions} { regexp .*a b @@ -240,11 +260,12 @@ test regexp-6.6 {regexp errors} { test regexp-6.7 {regexp errors} { list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg } {0 0} -test regexp-6.8 {regexp errors} { - catch {unset f1} +test regexp-6.8 {regexp errors} -setup { + unset -nocomplain f1 +} -body { set f1 44 - list [catch {regexp abc abc f1(f2)} msg] $msg -} {1 {couldn't set variable "f1(f2)"}} + regexp abc abc f1(f2) +} -returnCodes error -result {can't set "f1(f2)": variable isn't array} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} @@ -436,11 +457,12 @@ test regexp-11.5 {regsub errors} { test regexp-11.6 {regsub errors} { list [catch {regsub -nocase a( b c d} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} -test regexp-11.7 {regsub errors} { - catch {unset f1} +test regexp-11.7 {regsub errors} -setup { + unset -nocomplain f1 +} -body { set f1 44 - list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg -} {1 {couldn't set variable "f1(f2)"}} + regsub -nocase aaa aaa xxx f1(f2) +} -returnCodes error -result {can't set "f1(f2)": variable isn't array} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} @@ -507,23 +529,23 @@ test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -co } -result 1 test regexp-15.1 {regexp -start} { - catch {unset x} + unset -nocomplain x list [regexp -start -10 {\d} 1abc2de3 x] $x } {1 1} test regexp-15.2 {regexp -start} { - catch {unset x} + unset -nocomplain x list [regexp -start 2 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.3 {regexp -start} { - catch {unset x} + unset -nocomplain x list [regexp -start 4 {\d} 1abc2de3 x] $x } {1 2} test regexp-15.4 {regexp -start} { - catch {unset x} + unset -nocomplain x list [regexp -start 5 {\d} 1abc2de3 x] $x } {1 3} test regexp-15.5 {regexp -start, over end of string} { - catch {unset x} + unset -nocomplain x list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] } {0 0} test regexp-15.6 {regexp -start, loss of ^$ behavior} { @@ -536,24 +558,28 @@ test regexp-15.8 {regexp -start, double option} { regexp -start 0 -start 2 a abc } 0 test regexp-15.9 {regexp -start, end relative index} { - catch {unset x} + unset -nocomplain x list [regexp -start end {\d} 1abc2de3 x] [info exists x] } {0 0} test regexp-15.10 {regexp -start, end relative index} { - catch {unset x} + unset -nocomplain x list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x } {1 1 3} +test regexp-15.11 {regexp -start, over end of string} { + set x NA + list [regexp -start 2 {.*} ab x] $x +} {1 {}} test regexp-16.1 {regsub -start} { - catch {unset x} + unset -nocomplain x list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x } {4 a1b/2c/3d/4e/5} test regexp-16.2 {regsub -start} { - catch {unset x} + unset -nocomplain x list [regsub -all -start -25 {z} hello {/&} x] $x } {0 hello} test regexp-16.3 {regsub -start} { - catch {unset x} + unset -nocomplain x list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} test regexp-16.4 {regsub -start, \A behavior} { @@ -573,6 +599,62 @@ test regexp-16.7 {regexp -start, end relative index} { test regexp-16.8 {regexp -start, end relative index} { list [regsub -start end-1 a aaa b x] $x } {1 aab} +test regexp-16.9 {regsub -start and -all} { + set foo {} + list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo +} {2 a|xxx|b|xx|} +test regexp-16.10 {regsub -start and -all} { + set foo {} + list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo +} {2 a|xxx|b|xx|} +test regexp-16.11 {regsub -start and -all} { + set foo {} + list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo +} {1 axxxb|xx|} +test regexp-16.12 {regsub -start} { + set foo {} + list [regsub -start 4 x+ axxxbxx |&| foo] $foo +} {1 axxxb|xx|} +test regexp-16.13 {regsub -start and -all} { + set foo {} + list [regsub -start 1 -all a+ "" & foo] $foo +} {0 {}} +test regexp-16.14 {regsub -start} { + set foo {} + list [regsub -start 1 a+ "" & foo] $foo +} {0 {}} +test regexp-16.15 {regsub -start and -all} { + set foo {} + list [regsub -start 2 -all a+ "xy" & foo] $foo +} {0 xy} +test regexp-16.16 {regsub -start} { + set foo {} + list [regsub -start 2 a+ "xy" & foo] $foo +} {0 xy} +test regexp-16.17 {regsub -start and -all} { + set foo {} + list [regsub -start 1 -all y+ "xy" & foo] $foo +} {1 xy} +test regexp-16.18 {regsub -start} { + set foo {} + list [regsub -start 1 y+ "xy" & foo] $foo +} {1 xy} +test regexp-16.19 {regsub -start} { + set foo {} + list [regsub -start -1 a+ "" & foo] $foo +} {0 {}} +test regexp-16.20 {regsub -start, loss of ^$ behavior} { + set foo NA + list [regsub -start 1 {^$} {} & foo] $foo +} {0 {}} +test regexp-16.21 {regsub -start, loss of ^$ behavior} { + set foo NA + list [regsub -start 1 {^.*$} abc & foo] $foo +} {0 abc} +test regexp-16.22 {regsub -start, loss of ^$ behavior} { + set foo NA + list [regsub -all -start 1 {^.*$} abc & foo] $foo +} {0 abc} test regexp-17.1 {regexp -inline} { regexp -inline b ababa @@ -652,6 +734,12 @@ test regexp-19.1 {regsub null replacement} { list $result [string length $result] } "\0a\0hel\0a\0lo\0a\0 14" +test regexp-19.2 {regsub null replacement} { + regsub -all {@} {@hel@lo@} "\0a\0" result + set expected "\0a\0hel\0a\0lo\0a\0" + string equal $result $expected +} 1 + test regexp-20.1 {regsub shared object shimmering} { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz @@ -703,6 +791,27 @@ test regexp-21.12 {multiple matches handle newlines} { test regexp-21.13 {multiple matches handle newlines} { regexp -all -inline -indices -line -- ^ "a\nb\nc" } {{0 -1} {2 1} {4 3}} +test regexp-21.14 {regsub works with empty string} { + regsub -- ^ {} & +} {} +test regexp-21.15 {regsub works with empty string} { + regsub -- ^ {} foo& +} {foo} +test regexp-21.16 {regsub works with empty string} { + regsub -all -- ^ {} foo& +} {foo} +test regexp-21.17 {regsub works with empty string} { + regsub -- ^ {} {foo\0} +} {foo} +test regexp-21.18 {regsub works with empty string} { + regsub -- ^.* {} {foo$0} +} {foo$0} +test regexp-21.19 {regsub works with empty string} { + regsub -- ^ {input} {} +} {input} +test regexp-21.20 {regsub works with empty string} { + regsub -- x {} {foo} +} {} test regexp-22.1 {Bug 1810038} { regexp ($|^X)* {} @@ -710,6 +819,67 @@ test regexp-22.1 {Bug 1810038} { test regexp-22.2 {regexp compile and backrefs, Bug 1857126} { regexp -- {([bc])\1} bb } 1 +test regexp-22.3 {Bug 3604074} { + # This will hang in interps where the bug is not fixed + regexp ((((((((a)*)*)*)*)*)*)*)* a +} 1 +test regexp-22.4 {Bug 3606139} -setup { + interp alias {} a {} string repeat a +} -body { + # This crashes in interps where the bug is not fixed + regexp [join [list [a 160]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 671]([a 55])[a 671]([a 55]) \ + [a 672]([a 55])[a 652]([a 55])[a 672]([a 55])[a 671]([a 55]) \ + [a 671]([a 55])[a 671]([a 55])[a 653]([a 55])[a 672]([a 55]) \ + [a 653]([a 55])[a 672]([a 55])[a 672]([a 55])[a 652]([a 55]) \ + [a 671]([a 55])[a 652]([a 55])[a 652]([a 55])[a 672]([a 55]) \ + [a 672]([a 55])[a 672]([a 55])[a 653]([a 55])[a 671]([a 55]) \ + [a 669]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 650]([a 55])[a 650]([a 55])[a 672]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 672]([a 55]) \ + [a 670]([a 55])[a 671]([a 55])[a 672]([a 55])[a 672]([a 55]) \ + [a 671]([a 55])[a 671]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 668]([a 55])[a 669]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 710]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 667]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a +} -cleanup { + rename a {} +} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states} +test regexp-22.5 {Bug 3610026} -setup { + set e {} + set cp 99 + while {$cp < 32864} { + append e [format %c [incr cp]] + } +} -body { + regexp -about $e +} -cleanup { + unset -nocomplain e cp +} -returnCodes error -match glob -result {*too many colors*} +test regexp-22.6 {Bug 6585b21ca8} { + expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"} +} rogr + test regexp-23.1 {regexp -all and -line} { set string "" @@ -957,3 +1127,7 @@ test regexp-26.13 {regexp without -line option} { # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |