diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | tests/stack.test | 52 | ||||
| -rw-r--r-- | unix/tclUnixTest.c | 66 |
3 files changed, 13 insertions, 111 deletions
@@ -1,3 +1,9 @@ +2008-10-03 Miguel Sofer <msofer@users.sf.net> + + * tests/stack.test: + * unix/tclUnixTest.c: removed test command teststacklimit and the + corresponding constraint: it is not needed with NRE + 2008-10-03 Donal K. Fellows <dkf@users.sf.net> TIP #195 IMPLEMENTATION diff --git a/tests/stack.test b/tests/stack.test index 7d7f816..da587b5 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -9,72 +9,32 @@ # 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.24 2008/07/16 00:44:44 msofer Exp $ +# RCS: @(#) $Id: stack.test,v 1.25 2008/10/03 19:20:24 msofer 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). +# Note that a failure in this test may result in a crash of the executable. -# This doesn't catch all cases, for example threads of lower stacksize -# can still squeak through. A core check is really needed. -- JH - -testConstraint minStack2400 1 -testConstraint teststacklimit [llength [info commands teststacklimit]] - -if {[testConstraint unix]} { - if {[testConstraint teststacklimit]} { - set stackSize [teststacklimit] - } else { - set stackSize [exec /bin/sh -c "ulimit -s"] - } - if {($stackSize > -1) && ($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." - testConstraint minStack2400 0 - } -} - -# -# Custom match to detect a stack overflow independently of the mechanism that -# triggered the error. -# - -customMatch stackOverflow StackOverflow -proc StackOverflow {- res} { - set msgList [list \ - "too many nested evaluations (infinite loop?)"\ - "out of stack space (infinite loop?)"] - expr {$res in $msgList} -} - -test stack-1.1 {maxNestingDepth reached on infinite recursion} -constraints { - minStack2400 -} -body { +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 } -} -match stackOverflow +} -result {too many nested evaluations (infinite loop?)} -test stack-2.1 {maxNestingDepth reached on infinite recursion} -constraints { - minStack2400 -} -body { +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 } -} -match stackOverflow +} -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] diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 0e4c4b6..469e00a 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -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: tclUnixTest.c,v 1.28 2008/07/13 09:03:41 msofer Exp $ + * RCS: @(#) $Id: tclUnixTest.c,v 1.29 2008/10/03 19:20:24 msofer Exp $ */ #include "tclInt.h" @@ -82,8 +82,6 @@ static int TestgotsigCmd(ClientData dummy, static void AlarmHandler(int signum); static int TestchmodCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); -static int TeststacklimitCmd(ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -124,69 +122,7 @@ TclplatformtestInit( (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "teststacklimit", TeststacklimitCmd, - (ClientData) 0, NULL); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TeststacklimitCmd -- - * - * This function implements the "teststacklimit" command. When called - * with no arguments is sets the interp result to the current stack - * limit. When called with an integer argument it will set the stack size - * to the requested number (or the hard limit if it is smaller) and set - * the interp's result to the stack size prevalent before the change. - * Stack sizes are expressed in kB, as in 'ulimit'. - * - * A size of -1 means "unlimited". - * - * Results: - * A standard Tcl result. - * - * Side effects: - * May change the C stack size limit. - * - *---------------------------------------------------------------------- - */ - -static int -TeststacklimitCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ -#define STACK_SCALE 1024 - struct rlimit rlim; - int prev_limit, new_limit, result; - - if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, " ?limit?\""); - return TCL_ERROR; - } - - getrlimit(RLIMIT_STACK, &rlim); - prev_limit = ((rlim.rlim_cur == RLIM_INFINITY) - ? -1 - : (int) (rlim.rlim_cur/STACK_SCALE)); - - if (objc == 2) { - result = Tcl_GetIntFromObj(interp, objv[1], &new_limit); - if (result != TCL_OK) { - return result; - } - rlim.rlim_cur = ((new_limit == -1) - ? RLIM_INFINITY - : STACK_SCALE * (rlim_t) new_limit); - setrlimit(RLIMIT_STACK, &rlim); - } - - Tcl_SetObjResult(interp, Tcl_NewIntObj(prev_limit)); return TCL_OK; -#undef STACK_SCALE } /* |