# Tests that the stack size is big enough for the application.

 #

 # This file contains a collection of tests for one or more of the Tcl

 # 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-2000 Ajuba Solutions.

 # Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved. 

 #

 # 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.15.2.1 2004/05/03 18:01:36 kennykb 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).

 # 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"]} {

     if {[string equal $tcl_platform(osSystemName) "Symbian"]} {

     # cannot dynamically set stack size in Symbian, and max stack size is 80K in Symbian

     set stackSize 80

     } else {

     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

     }

 } 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?)}

 # Make sure that there is enough stack to run regexp even if we're

 # close to the recursion limit. [Bug 947070]

 test stack-3.1 {enough room for regexp near recursion limit} \

     -constraints { win } \

     -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

 	    }

 	}

 	list [catch { a 10001 }]

 	incr depth -3

 	set depth2 $depth

     } -body {

 	list [catch { a $::depth } result] \

 	    $result [expr { $::depth2 - $::depth }]

     } -cleanup {

 	interp recursionlimit {} $::limit

     } -result {0 1 1}

 # cleanup

 ::tcltest::cleanupTests

 return

 # Local Variables:

 # mode: tcl

 # End: