diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | tests/stack.test | 58 |
2 files changed, 35 insertions, 29 deletions
@@ -1,3 +1,9 @@ +2006-03-22 Reinhard Max <max@suse.de> + + * tests/stack.test: Run the stack tests in subshells, so that they + are reported as failed tests rather than bugs in the test suite if + the recursion causes a segfault. + 2006-03-21 Don Porter <dgp@users.sourceforge.net> *** 8.5a4 TAGGED FOR RELEASE *** diff --git a/tests/stack.test b/tests/stack.test index 047e0e8..e09e9c1 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -9,7 +9,7 @@ # 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.19 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: stack.test,v 1.20 2006/03/22 18:32:39 rmax Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -36,42 +36,42 @@ if {[testConstraint unix]} { } test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} { - proc recurse {} { return [recurse] } - catch {recurse} rv - rename recurse {} - set rv + # do this in a sub process in case it segfaults + exec [interpreter] << { + proc recurse {} { recurse } + catch { recurse } rv + puts $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 + # do this in a sub process in case it segfaults + exec [interpreter] << { + interp alias {} unknown {} notaknownproc + catch { unknown } msg + puts $msg + } } {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 |