From 8005d246ab941564f32c4a93c3c73eb1a13e3269 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Fri, 29 Sep 2000 21:42:35 +0000
Subject: 	* tests/stack.test: prevented possible crash on systems with
 low 	default stacksize (Tru64, AIX) in infinite recursion test.  A 
 solution to check remaining stack space in the core is best, but 	hard
 to do in a cross-platform manner.

---
 tests/stack.test | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/tests/stack.test b/tests/stack.test
index 19a5104..9176201 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -4,12 +4,12 @@
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
 #
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
 #
 # 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.8 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: stack.test,v 1.9 2000/09/29 21:42:35 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -17,8 +17,28 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 # 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).
 
-test stack-1.1 {maxNestingDepth reached on infinite recursion} {
+# This doesn't catch all cases, for example threads of lower stacksize
+# can still squeak through.  A core check is really needed. -- JH
+
+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
+    }
+} 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 {}
-- 
cgit v0.12