From dd73a7d278b7721922e373f9310c04f301fdbcac Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 20 May 2004 13:04:10 +0000 Subject: Delete limit callbacks properly when the interpreters involved are deleted. --- ChangeLog | 8 ++++++ generic/tclBasic.c | 11 +++++++- generic/tclInt.h | 8 ++++-- generic/tclInterp.c | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++- tests/interp.test | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 174 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0cdcacf..9b5c59c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2004-05-20 Donal K. Fellows + + * generic/tclInterp.c (TclLimitRemoveAllHandlers): + * generic/tclBasic.c (DeleteInterpProc): + * tests/interp.test (interp-34.7): + Ensure that all limit callbacks are deleted when their interpreters + are deleted. [Bug 956083] + 2004-05-19 Kevin B. Kenny * win/tclWinFile.c (TclpMatchInDirectory): fix for an issue diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3054f98..248f893 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.101 2004/05/16 20:23:01 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.102 2004/05/20 13:04:11 dkf Exp $ */ #include "tclInt.h" @@ -984,6 +984,15 @@ DeleteInterpProc(interp) TclHandleFree(iPtr->handle); /* + * Shut down all limit handler callback scripts that call back + * into this interpreter. Then eliminate all limit handlers for + * this interpreter. + */ + + TclDecommissionLimitCallbacks(interp); + TclLimitRemoveAllHandlers(interp); + + /* * Dismantle everything in the global namespace except for the * "errorInfo" and "errorCode" variables. These remain until the * namespace is actually destroyed, in case any errors occur. diff --git a/generic/tclInt.h b/generic/tclInt.h index d0d60ce..c007b74 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.160 2004/05/13 20:31:08 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.161 2004/05/20 13:04:11 dkf Exp $ */ #ifndef _TCLINT @@ -1714,6 +1714,8 @@ EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj)); EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp, CONST char *value)); +EXTERN void TclDecommissionLimitCallbacks _ANSI_ARGS_(( + Tcl_Interp *interp)); EXTERN void TclExpandTokenArray _ANSI_ARGS_(( Tcl_Parse *parsePtr)); EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp, @@ -1751,6 +1753,7 @@ EXTERN void TclInitEmbeddedConfigurationInformation _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void)); EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void)); +EXTERN void TclInitLimitSupport _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN void TclInitNamespaceSubsystem _ANSI_ARGS_((void)); EXTERN void TclInitNotifier _ANSI_ARGS_((void)); EXTERN void TclInitObjSubsystem _ANSI_ARGS_((void)); @@ -1759,7 +1762,8 @@ EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src, int len)); EXTERN int TclJoinThread _ANSI_ARGS_((Tcl_ThreadId id, int* result)); -EXTERN void TclInitLimitSupport _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void TclLimitRemoveAllHandlers _ANSI_ARGS_(( + Tcl_Interp *interp)); EXTERN Tcl_Obj * TclLindexList _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* listPtr, Tcl_Obj* argPtr )); diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 35efdd3..0354f5e 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.31 2004/05/19 21:56:37 dkf Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.32 2004/05/20 13:04:11 dkf Exp $ */ #include "tclInt.h" @@ -2849,6 +2849,80 @@ Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData) } } +void +TclLimitRemoveAllHandlers(interp) + Tcl_Interp *interp; +{ + Interp *iPtr = (Interp *) interp; + LimitHandler *handlerPtr, *nextHandlerPtr; + + /* + * Delete all command-limit handlers. + */ + + for (handlerPtr=iPtr->limit.cmdHandlers, iPtr->limit.cmdHandlers=NULL; + handlerPtr!=NULL; handlerPtr=nextHandlerPtr) { + nextHandlerPtr = handlerPtr->nextPtr; + + /* + * Do not delete here if it has already been marked for deletion. + */ + + if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { + continue; + } + handlerPtr->flags |= LIMIT_HANDLER_DELETED; + handlerPtr->prevPtr = NULL; + handlerPtr->nextPtr = NULL; + + /* + * If nothing is currently executing the handler, delete its + * client data and the overall handler structure now. + * Otherwise it will all go away when the handler returns. + */ + + if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { + if (handlerPtr->deleteProc != NULL) { + (handlerPtr->deleteProc)(handlerPtr->clientData); + } + ckfree((char *) handlerPtr); + } + } + + /* + * Delete all time-limit handlers. + */ + + for (handlerPtr=iPtr->limit.timeHandlers, iPtr->limit.timeHandlers=NULL; + handlerPtr!=NULL; handlerPtr=nextHandlerPtr) { + nextHandlerPtr = handlerPtr->nextPtr; + + /* + * Do not delete here if it has already been marked for deletion. + */ + + if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { + continue; + } + handlerPtr->flags |= LIMIT_HANDLER_DELETED; + handlerPtr->prevPtr = NULL; + handlerPtr->nextPtr = NULL; + + /* + * If nothing is currently executing the handler, delete its + * client data and the overall handler structure now. + * Otherwise it will all go away when the handler returns. + */ + + if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { + if (handlerPtr->deleteProc != NULL) { + (handlerPtr->deleteProc)(handlerPtr->clientData); + } + ckfree((char *) handlerPtr); + } + } +} + int Tcl_LimitTypeEnabled(interp, type) Tcl_Interp *interp; diff --git a/tests/interp.test b/tests/interp.test index a26ab90..8298df1 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.35 2004/05/19 22:22:04 dkf Exp $ +# RCS: @(#) $Id: interp.test,v 1.36 2004/05/20 13:04:12 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -2955,6 +2955,9 @@ test interp-34.4 {limits with callbacks: extending limits} -setup { rename cb1 {} rename cb2 {} } +# The next three tests exercise all the three ways that limit handlers +# can be deleted. Fully verifying this requires additional source +# code instrumentation. test interp-34.5 {limits with callbacks: removing limits} -setup { set i [interp create] set a 0 @@ -2980,6 +2983,77 @@ test interp-34.5 {limits with callbacks: removing limits} -setup { rename cb1 {} rename cb2 {} } +test interp-34.6 {limits with callbacks: removing limits and handlers} -setup { + set i [interp create] + set a 0 + set b 0 + set c a + proc cb1 {} { + global c + incr ::$c + } + proc cb2 {args} { + global c i + set c b + $i limit command -value {} -command {} + } +} -body { + interp alias $i foo {} cb1 + set curlim [$i eval info cmdcount] + $i limit command -command cb2 -value [expr {$curlim+10}] + $i eval {for {set i 0} {$i<10} {incr i} {foo}} + list $a $b $c +} -result {6 4 b} -cleanup { + interp delete $i + rename cb1 {} + rename cb2 {} +} +test interp-34.7 {limits with callbacks: deleting the handler interp} -setup { + set i [interp create] + $i eval { + set i [interp create] + proc cb1 {} { + global c + incr ::$c + } + proc cb2 {args} { + global c i curlim + set c b + $i limit command -value [expr {$curlim+1000}] + trapToParent + } + } + proc cb3 {} { + global i subi + interp alias [list $i $subi] foo {} cb4 + interp delete $i + } + proc cb4 {} { + global n + incr n + } +} -body { + set subi [$i eval set i] + interp alias $i trapToParent {} cb3 + set n 0 + $i eval { + set a 0 + set b 0 + set c a + interp alias $i foo {} cb1 + set curlim [$i eval info cmdcount] + $i limit command -command cb2 -value [expr {$curlim+10}] + } + $i eval { + $i eval { + for {set i 0} {$i<10} {incr i} {foo} + } + } + list $n [interp exists $i] +} -result {4 0} -cleanup { + rename cb3 {} + rename cb4 {} +} test interp-35.1 {interp limit syntax} -body { interp limit -- cgit v0.12