diff options
Diffstat (limited to 'tests/stack.test')
| -rw-r--r-- | tests/stack.test | 84 |
1 files changed, 43 insertions, 41 deletions
diff --git a/tests/stack.test b/tests/stack.test index fef667e..13bc524 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -8,53 +8,55 @@ # # 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.11 2001/09/11 18:26:27 hobbs Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - 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 inifite recursion test." - set ::tcltest::testConstraints(minStack2400) 0 - } else { - set ::tcltest::testConstraints(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 { - set ::tcltest::testConstraints(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 calls to Tcl_EvalObj (infinite loop?)} +} -result {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 calls to AliasObjCmd (infinite loop using alias?)} +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} -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 }]] + } +} -result {1 1} # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |