diff options
Diffstat (limited to 'tests/stack.test')
| -rw-r--r-- | tests/stack.test | 86 |
1 files changed, 48 insertions, 38 deletions
diff --git a/tests/stack.test b/tests/stack.test index e029bbd..96bcb98 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -21,46 +21,60 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # This doesn't catch all cases, for example threads of lower stacksize # can still squeak through. A core check is really needed. -- JH -if {[string equal $::tcl_platform(platform) "unix"]} { +testConstraint minStack2034 1 +if {[testConstraint unix]} { set stackSize [exec /bin/sh -c "ulimit -s"] - if {[string is integer $stackSize] && ($stackSize < 2400)} { + if {[string is integer $stackSize] && ($stackSize < 2034)} { puts stderr "WARNING: the default application stacksize of $stackSize\ may cause Tcl to\ncrash due to stack overflow before the\ - recursion limit is reached.\nA minimum stacksize of 2400\ + recursion limit is reached.\nA minimum stacksize of 2034\ kbytes is recommended.\nSkipping infinite recursion test." - ::tcltest::testConstraint minStack2400 0 - } else { - ::tcltest::testConstraint minStack2400 1 + testConstraint minStack2034 0 } -} else { - ::tcltest::testConstraint minStack2400 1 } -test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} { - proc recurse {} { return [recurse] } - catch {recurse} rv - rename recurse {} - set rv -} {too many nested evaluations (infinite loop?)} +# +# Custom match to detect a stack overflow independently of the mechanism that +# triggered the error. +# -test stack-2.1 {maxNestingDepth reached on infinite recursion} {minStack2400} { - # do this in a slave to not mess with parent - set slave stack-2.1 - interp create $slave - $slave eval { interp alias {} unknown {} notaknownproc } - set msg [$slave eval { catch {foo} msg ; set msg }] - interp delete $slave - set msg -} {too many nested evaluations (infinite loop?)} +customMatch stackOverflow StackOverflow +proc StackOverflow {- res} { + set msgList [list \ + "too many nested evaluations (infinite loop?)"\ + "out of stack space (infinite loop?)"] + expr {$res in $msgList} +} -# Make sure that there is enough stack to run regexp even if we're -# close to the recursion limit. [Bug 947070] +test stack-1.1 {maxNestingDepth reached on infinite recursion} -constraints { + minStack2034 +} -body { + # do this in a sub process in case it segfaults + exec [interpreter] << { + proc recurse {} { recurse } + catch { recurse } rv + puts $rv + } +} -match stackOverflow -test stack-3.1 {enough room for regexp near recursion limit} \ - -constraints { win } \ - -setup { - set ::limit [interp recursionlimit {} 10000] - set ::depth 0 +test stack-2.1 {maxNestingDepth reached on infinite recursion} -constraints { + minStack2034 +} -body { + # do this in a sub process in case it segfaults + exec [interpreter] << { + interp alias {} unknown {} notaknownproc + catch { unknown } msg + puts $msg + } +} -match stackOverflow + +# Make sure that there is enough stack to run regexp even if we're +# close to the recursion limit. [Bug 947070] [Patch 746378] +test stack-3.1 {enough room for regexp near recursion limit} -body { + # do this in a sub process in case it segfaults + exec [interpreter] << { + interp recursionlimit {} 10000 + set depth 0 proc a { max } { if { [info level] < $max } { set ::depth [info level] @@ -69,15 +83,11 @@ test stack-3.1 {enough room for regexp near recursion limit} \ regexp {^ ?} x } } - list [catch { a 10001 }] - incr depth -3 + catch { a 10001 } set depth2 $depth - } -body { - list [catch { a $::depth } result] \ - $result [expr { $::depth2 - $::depth }] - } -cleanup { - interp recursionlimit {} $::limit - } -result {0 1 1} + puts [list [a $depth] [expr { $depth2 - $depth }]] + } +} -result {1 1} # cleanup ::tcltest::cleanupTests |