summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--tests/stack.test58
2 files changed, 35 insertions, 29 deletions
diff --git a/ChangeLog b/ChangeLog
index 09ad53a..e7e8fd6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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