summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-20 13:04:10 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-20 13:04:10 (GMT)
commitdd73a7d278b7721922e373f9310c04f301fdbcac (patch)
tree32f0081a587e4d9bb0b35b8d472cb716b9364393 /generic
parentea59419c25449100febc3fb0ed1f7fee1b9c7e8a (diff)
downloadtcl-dd73a7d278b7721922e373f9310c04f301fdbcac.zip
tcl-dd73a7d278b7721922e373f9310c04f301fdbcac.tar.gz
tcl-dd73a7d278b7721922e373f9310c04f301fdbcac.tar.bz2
Delete limit callbacks properly when the interpreters involved are deleted.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c11
-rw-r--r--generic/tclInt.h8
-rw-r--r--generic/tclInterp.c76
3 files changed, 91 insertions, 4 deletions
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;