diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-18 14:26:34 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-18 14:26:34 (GMT) |
commit | 768fa857c25a31f96cfdfeeb34e8628f68ddb7ba (patch) | |
tree | 442610189942d07ad62a95d79fe477c0a2f54d51 | |
parent | 4d7b9162e578238f275688adcef5d56242b8ae7e (diff) | |
download | tcl-768fa857c25a31f96cfdfeeb34e8628f68ddb7ba.zip tcl-768fa857c25a31f96cfdfeeb34e8628f68ddb7ba.tar.gz tcl-768fa857c25a31f96cfdfeeb34e8628f68ddb7ba.tar.bz2 |
Add more representation smashing testing and a memleak test.
-rw-r--r-- | tests/regexp.test | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/regexp.test b/tests/regexp.test index ad770fa..f1be6eb 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -19,6 +19,20 @@ if {"::tcltest" ni [namespace children]} { unset -nocomplain foo testConstraint exec [llength [info commands exec]] + +# Used for constraining memory leak tests +testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc memtest script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} + } +} test regexp-1.1 {basic regexp operation} { regexp ab*c abbbc @@ -1149,6 +1163,21 @@ test regexp-27.7 {regsub -command representation smash} { expr {[llength $::s] + $n} }}} } {125=458 791} +test regexp-27.8 {regsub -command representation smash} { + set ::t {apply {n { + expr {[llength [lindex $::t 1 1 1]] + $n} + }}} + regsub -command -all {\d+} "123=456 789" $::t +} {131=464 797} +test regexp-27.9 {regsub -command memory leak testing} memory { + set ::s "123=456 789" + set ::t {apply {n { + expr {[llength [lindex $::t 1 1 1]] + [llength $::s] + $n} + }}} + memtest { + regsub -command -all {\d+} $::s $::t + } +} 0 # cleanup ::tcltest::cleanupTests |