diff options
Diffstat (limited to 'tests/stack.test')
| -rw-r--r-- | tests/stack.test | 94 |
1 files changed, 35 insertions, 59 deletions
diff --git a/tests/stack.test b/tests/stack.test index 64b669a..13bc524 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -8,73 +8,49 @@ # # 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.18 2004/06/23 00:24:43 dkf 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] [Patch 746378] -test stack-3.1 {enough room for regexp near recursion limit} -setup { - set limit [interp recursionlimit {} 10000] - set depth 0 - proc a { max } { - if { [info level] < $max } { - set ::depth [info level] - a $max - } else { - regexp {^ ?} x +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] + a $max + } else { + regexp {^ ?} x + } } + catch { a 10001 } + set depth2 $depth + puts [list [a $depth] [expr { $depth2 - $depth }]] } -} -body { - catch { a 10001 } - set depth2 $depth - list [a $depth] [expr { $depth2 - $depth }] -} -cleanup { - interp recursionlimit {} $limit - rename a {} } -result {1 1} # cleanup |