diff options
Diffstat (limited to 'tests/stack.test')
| -rw-r--r-- | tests/stack.test | 86 |
1 files changed, 29 insertions, 57 deletions
diff --git a/tests/stack.test b/tests/stack.test index dfcf9c2..13bc524 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -8,61 +8,37 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: stack.test,v 1.16 2004/05/03 17:04:31 kennykb Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} -# Note that a failure in this test results in a crash of the executable. -# In order to avoid that, we do a basic check of the current stacksize. -# This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh). +package require tcltest 2 +namespace import ::tcltest::* -# This doesn't catch all cases, for example threads of lower stacksize -# can still squeak through. A core check is really needed. -- JH +# Note that a failure in this test may result in a crash of the executable. -if {[string equal $::tcl_platform(platform) "unix"]} { - set stackSize [exec /bin/sh -c "ulimit -s"] - if {[string is integer $stackSize] && ($stackSize < 2400)} { - 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\ - kbytes is recommended.\nSkipping infinite recursion test." - ::tcltest::testConstraint minStack2400 0 - } else { - ::tcltest::testConstraint minStack2400 1 +test stack-1.1 {maxNestingDepth reached on infinite recursion} -body { + # do this in a sub process in case it segfaults + exec [interpreter] << { + proc recurse {} { recurse } + catch { recurse } rv + puts $rv } -} 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?)} - -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?)} - +} -result {too many nested evaluations (infinite loop?)} + +test stack-2.1 {maxNestingDepth reached on infinite recursion} -body { + # do this in a sub process in case it segfaults + exec [interpreter] << { + interp alias {} unknown {} notaknownproc + catch { unknown } msg + puts $msg + } +} -result {too many nested evaluations (infinite loop?)} + # Make sure that there is enough stack to run regexp even if we're -# close to the recursion limit. [Bug 947070] - -test stack-3.1 {enough room for regexp near recursion limit} \ - -constraints { win } \ - -setup { - set ::limit [interp recursionlimit {} 10000] - set ::depth 0 +# 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] @@ -72,14 +48,10 @@ test stack-3.1 {enough room for regexp near recursion limit} \ } } catch { a 10001 } - incr depth -2 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 |