Delete limit callbacks properly when the interpreters involved are deleted.

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  <donal.k.fellows@man.ac.uk>
+
+	* 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  <kennykb@acm.org>
 
 	* 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