summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-10-10 17:33:25 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-10-10 17:33:25 (GMT)
commit74451872e37a31feb47b7be05b8175603f0526ce (patch)
treee7cc109788ffe0692afffb847928fa9eba126fc6
parentdb048c3be987aa1a9a98a71fc6e164ca746b9333 (diff)
downloadtcl-74451872e37a31feb47b7be05b8175603f0526ce.zip
tcl-74451872e37a31feb47b7be05b8175603f0526ce.tar.gz
tcl-74451872e37a31feb47b7be05b8175603f0526ce.tar.bz2
Fix two bugs in limits, one a crash and the other a failed flag reset.
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclInterp.c756
-rw-r--r--tests/interp.test64
3 files changed, 446 insertions, 385 deletions
diff --git a/ChangeLog b/ChangeLog
index 87bad14..4de4612 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-10-10 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclInterp.c (DeleteScriptLimitCallback)
+ (SetScriptLimitCallback): Improve the interlocking between the script
+ limit callback record and the hash table of current such records, to
+ prevent crashes in callbacks that create callbacks.
+ (Tcl_LimitSetTime): Reset the correct flag. Problem reported by
+ Nicolas Castagne <castagne@imag.fr> on comp.lang.tcl
+
2005-10-10 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c: fixing errors in last commit. (Two
@@ -13,7 +22,7 @@
2005-10-08 Don Porter <dgp@users.sourceforge.net>
- TIP#237 IMPLEMENTATION
+ TIP#237 IMPLEMENTATION
[kennykb-numerics-branch] Resynchronized with the HEAD; at this
checkpoint [-rkennykb-numerics-branch-20051008], the HEAD and
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index c521435..364416a 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.60 2005/07/17 21:17:42 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.61 2005/10/10 17:33:26 dkf Exp $
*/
#include "tclInt.h"
@@ -18,11 +18,10 @@
/*
* A pointer to a string that holds an initialization script that if non-NULL
* is evaluated in Tcl_Init() prior to the built-in initialization script
- * above. This variable can be modified by the procedure below.
+ * above. This variable can be modified by the procedure below.
*/
-static char * tclPreInitScript = NULL;
-
+static char *tclPreInitScript = NULL;
/* Forward declaration */
struct Target;
@@ -50,9 +49,9 @@ typedef struct Alias {
* This is used by alias deletion to remove
* the alias from the slave interpreter alias
* table. */
- struct Target *targetPtr; /* Entry for target command in master. This
- * is used in the master interpreter to map
- * back from the target command to aliases
+ struct Target *targetPtr; /* Entry for target command in master. This is
+ * used in the master interpreter to map back
+ * from the target command to aliases
* redirecting to it. */
int objc; /* Count of Tcl_Obj in the prefix of the
* target command to be invoked in the target
@@ -80,7 +79,7 @@ typedef struct Slave {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
- * slave interpreter. Used to find this
+ * slave interpreter. Used to find this
* record, and used when deleting the slave
* interpreter to delete it from the master's
* table. */
@@ -156,99 +155,95 @@ typedef struct InterpInfo {
/*
* Limit callbacks handled by scripts are modelled as structures which are
- * stored in hashes indexed by a two-word key. Note that the type of the
+ * stored in hashes indexed by a two-word key. Note that the type of the
* 'type' field in the key is not int; this is to make sure that things are
* likely to work properly on 64-bit architectures.
*/
-struct ScriptLimitCallback {
- Tcl_Interp *interp;
- Tcl_Obj *scriptObj;
- int type;
- Tcl_HashEntry *entryPtr;
-};
+typedef struct ScriptLimitCallback {
+ Tcl_Interp *interp; /* The interpreter in which to execute the
+ * callback. */
+ Tcl_Obj *scriptObj; /* The script to execute to perform the
+ * user-defined part of the callback. */
+ int type; /* What kind of callback is this. */
+ Tcl_HashEntry *entryPtr; /* The entry in the hash table maintained by
+ * the target interpreter that refers to this
+ * callback record, or NULL if the entry has
+ * already been deleted from that hash
+ * table. */
+} ScriptLimitCallback;
-struct ScriptLimitCallbackKey {
- Tcl_Interp *interp;
- long type;
-};
+typedef struct ScriptLimitCallbackKey {
+ Tcl_Interp *interp; /* The interpreter that the limit callback was
+ * attached to. This is not the interpreter
+ * that the callback runs in! */
+ long type; /* The type of callback that this is. */
+} ScriptLimitCallbackKey;
/*
* Prototypes for local static procedures:
*/
-static int AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
+static int AliasCreate(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));
-static int AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));
-static int AliasList _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int AliasObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Obj *CONST objv[]);
+static int AliasDelete(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
+static int AliasDescribe(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
+static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
+static int AliasObjCmd(ClientData dummy,
Tcl_Interp *currentInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static void AliasObjCmdDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-
-static Tcl_Interp * GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr));
-static Tcl_Interp * GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void InterpInfoDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static int SlaveBgerror _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static Tcl_Interp * SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int safe));
-static int SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *CONST objv[]);
+static void AliasObjCmdDeleteProc(ClientData clientData);
+static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]);
+static void InterpInfoDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static int SlaveBgerror(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *CONST objv[]);
+static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ int safe);
+static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int SlaveExpose(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *CONST objv[]);
+static int SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int SlaveHidden(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp);
+static int SlaveInvokeHidden(Tcl_Interp *interp,
Tcl_Interp *slaveInterp,
CONST char *namespaceName,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp));
-static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-static int SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int SlaveMarkTrusted(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp);
+static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static void SlaveObjCmdDeleteProc(ClientData clientData);
+static int SlaveRecursionLimit(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
- Tcl_Obj *CONST objv[]));
-static int SlaveCommandLimitCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *CONST objv[]);
+static int SlaveCommandLimitCmd(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int consumedObjc,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveTimeLimitCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int SlaveTimeLimitCmd(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int consumedObjc,
- int objc, Tcl_Obj *CONST objv[]));
-static void InheritLimitsFromMaster _ANSI_ARGS_((
- Tcl_Interp *slaveInterp,
- Tcl_Interp *masterInterp));
-static void SetScriptLimitCallback _ANSI_ARGS_((Tcl_Interp *interp,
- int type, Tcl_Interp *targetInterp,
- Tcl_Obj *scriptObj));
-static void CallScriptLimitCallback _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void DeleteScriptLimitCallback _ANSI_ARGS_((
- ClientData clientData));
-static void RunLimitHandlers _ANSI_ARGS_((LimitHandler *handlerPtr,
- Tcl_Interp *interp));
-static void TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
-
+ int objc, Tcl_Obj *CONST objv[]);
+static void InheritLimitsFromMaster(Tcl_Interp *slaveInterp,
+ Tcl_Interp *masterInterp);
+static void SetScriptLimitCallback(Tcl_Interp *interp, int type,
+ Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
+static void CallScriptLimitCallback(ClientData clientData,
+ Tcl_Interp *interp);
+static void DeleteScriptLimitCallback(ClientData clientData);
+static void RunLimitHandlers(LimitHandler *handlerPtr,
+ Tcl_Interp *interp);
+static void TimeLimitCallback(ClientData clientData);
/*
*----------------------------------------------------------------------
@@ -268,8 +263,8 @@ static void TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
*/
char *
-TclSetPreInitScript (string)
- char *string; /* Pointer to a script. */
+TclSetPreInitScript(
+ char *string) /* Pointer to a script. */
{
char *prevString = tclPreInitScript;
tclPreInitScript = string;
@@ -296,8 +291,8 @@ TclSetPreInitScript (string)
*/
int
-Tcl_Init(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
+Tcl_Init(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
{
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
@@ -307,29 +302,29 @@ Tcl_Init(interp)
/*
* In order to find init.tcl during initialization, the following script
- * is invoked by Tcl_Init(). It looks in several different directories:
+ * is invoked by Tcl_Init(). It looks in several different directories:
*
* $tcl_library - can specify a primary location, if set, no
- * other locations will be checked. This is
- * the recommended way for a program that
- * embeds Tcl to specifically tell Tcl where to
- * find an init.tcl file.
+ * other locations will be checked. This is the
+ * recommended way for a program that embeds
+ * Tcl to specifically tell Tcl where to find
+ * an init.tcl file.
*
* $env(TCL_LIBRARY) - highest priority so user can always override
* the search path unless the application has
* specified an exact directory above
*
- * $tclDefaultLibrary - INTERNAL: This variable is set by Tcl
- * on those platforms where it can determine at
+ * $tclDefaultLibrary - INTERNAL: This variable is set by Tcl on
+ * those platforms where it can determine at
* runtime the directory where it expects the
- * init.tcl file to be. After [tclInit] reads
+ * init.tcl file to be. After [tclInit] reads
* and uses this value, it [unset]s it.
* External users of Tcl should not make use of
* the variable to customize [tclInit].
*
- * $tcl_libPath - OBSOLETE: This variable is no longer
- * set by Tcl itself, but [tclInit] examines it
- * in case some program that embeds Tcl is
+ * $tcl_libPath - OBSOLETE: This variable is no longer set by
+ * Tcl itself, but [tclInit] examines it in
+ * case some program that embeds Tcl is
* customizing [tclInit] by setting this
* variable to a list of directories in which
* to search.
@@ -417,8 +412,7 @@ Tcl_Init(interp)
* TclInterpInit --
*
* Initializes the invoking interpreter for using the master, slave and
- * safe interp facilities. This is called from inside
- * Tcl_CreateInterp().
+ * safe interp facilities. This is called from inside Tcl_CreateInterp().
*
* Results:
* Always returns TCL_OK for backwards compatibility.
@@ -431,8 +425,8 @@ Tcl_Init(interp)
*/
int
-TclInterpInit(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
+TclInterpInit(
+ Tcl_Interp *interp) /* Interpreter to initialize. */
{
InterpInfo *interpInfoPtr;
Master *masterPtr;
@@ -463,7 +457,7 @@ TclInterpInit(interp)
*
* InterpInfoDeleteProc --
*
- * Invoked when an interpreter is being deleted. It releases all storage
+ * Invoked when an interpreter is being deleted. It releases all storage
* used by the master/slave/safe interpreter facilities.
*
* Results:
@@ -476,9 +470,9 @@ TclInterpInit(interp)
*/
static void
-InterpInfoDeleteProc(clientData, interp)
- ClientData clientData; /* Ignored. */
- Tcl_Interp *interp; /* Interp being deleted. All commands for
+InterpInfoDeleteProc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp) /* Interp being deleted. All commands for
* slave interps should already be deleted. */
{
InterpInfo *interpInfoPtr;
@@ -542,8 +536,8 @@ InterpInfoDeleteProc(clientData, interp)
*
* Tcl_InterpObjCmd --
*
- * This procedure is invoked to process the "interp" Tcl command. See
- * the user documentation for details on what it does.
+ * This procedure is invoked to process the "interp" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -555,11 +549,11 @@ InterpInfoDeleteProc(clientData, interp)
*/
/* ARGSUSED */
int
-Tcl_InterpObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Unused. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_InterpObjCmd(
+ ClientData clientData, /* Unused. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int index;
static CONST char *options[] = {
@@ -1045,11 +1039,11 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
*/
static Tcl_Interp *
-GetInterp2(interp, objc, objv)
- Tcl_Interp *interp; /* Default interp if no interp was specified
+GetInterp2(
+ Tcl_Interp *interp, /* Default interp if no interp was specified
* on the command line. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
if (objc == 2) {
return interp;
@@ -1078,13 +1072,13 @@ GetInterp2(interp, objc, objv)
*/
int
-Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- CONST char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- CONST char *targetCmd; /* Name of target command. */
- int argc; /* How many additional arguments? */
- CONST char * CONST *argv; /* These are the additional args. */
+Tcl_CreateAlias(
+ Tcl_Interp *slaveInterp, /* Interpreter for source command. */
+ CONST char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *targetInterp, /* Interpreter for target command. */
+ CONST char *targetCmd, /* Name of target command. */
+ int argc, /* How many additional arguments? */
+ CONST char *CONST *argv) /* These are the additional args. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
Tcl_Obj **objv;
@@ -1133,13 +1127,13 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
*/
int
-Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- CONST char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- CONST char *targetCmd; /* Name of target command. */
- int objc; /* How many additional arguments? */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
+Tcl_CreateAliasObj(
+ Tcl_Interp *slaveInterp, /* Interpreter for source command. */
+ CONST char *slaveCmd, /* Command to install in slave. */
+ Tcl_Interp *targetInterp, /* Interpreter for target command. */
+ CONST char *targetCmd, /* Name of target command. */
+ int objc, /* How many additional arguments? */
+ Tcl_Obj *CONST objv[]) /* Argument vector. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
int result;
@@ -1175,14 +1169,14 @@ Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
*/
int
-Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
- argvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- CONST char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- CONST char **targetNamePtr; /* (Return) name of target command. */
- int *argcPtr; /* (Return) count of addnl args. */
- CONST char ***argvPtr; /* (Return) additional arguments. */
+Tcl_GetAlias(
+ Tcl_Interp *interp, /* Interp to start search from. */
+ CONST char *aliasName, /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr,
+ /* (Return) target interpreter. */
+ CONST char **targetNamePtr, /* (Return) name of target command. */
+ int *argcPtr, /* (Return) count of addnl args. */
+ CONST char ***argvPtr) /* (Return) additional arguments. */
{
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
@@ -1237,14 +1231,14 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
*/
int
-Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
- objvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- CONST char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- CONST char **targetNamePtr; /* (Return) name of target command. */
- int *objcPtr; /* (Return) count of addnl args. */
- Tcl_Obj ***objvPtr; /* (Return) additional args. */
+Tcl_GetAliasObj(
+ Tcl_Interp *interp, /* Interp to start search from. */
+ CONST char *aliasName, /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr,
+ /* (Return) target interpreter. */
+ CONST char **targetNamePtr, /* (Return) name of target command. */
+ int *objcPtr, /* (Return) count of addnl args. */
+ Tcl_Obj ***objvPtr) /* (Return) additional args. */
{
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
@@ -1301,12 +1295,11 @@ Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
*/
int
-TclPreventAliasLoop(interp, cmdInterp, cmd)
- Tcl_Interp *interp; /* Interp in which to report errors. */
- Tcl_Interp *cmdInterp; /* Interp in which the command is
- * being defined. */
- Tcl_Command cmd; /* Tcl command we are attempting to
- * define. */
+TclPreventAliasLoop(
+ Tcl_Interp *interp, /* Interp in which to report errors. */
+ Tcl_Interp *cmdInterp, /* Interp in which the command is being
+ * defined. */
+ Tcl_Command cmd) /* Tcl command we are attempting to define. */
{
Command *cmdPtr = (Command *) cmd;
Alias *aliasPtr, *nextAliasPtr;
@@ -1398,17 +1391,16 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
*/
static int
-AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
- objc, objv)
- Tcl_Interp *interp; /* Interp for error reporting. */
- Tcl_Interp *slaveInterp; /* Interp where alias cmd will live or from
+AliasCreate(
+ Tcl_Interp *interp, /* Interp for error reporting. */
+ Tcl_Interp *slaveInterp, /* Interp where alias cmd will live or from
* which alias will be deleted. */
- Tcl_Interp *masterInterp; /* Interp in which target command will be
+ Tcl_Interp *masterInterp, /* Interp in which target command will be
* invoked. */
- Tcl_Obj *namePtr; /* Name of alias cmd. */
- Tcl_Obj *targetNamePtr; /* Name of target cmd. */
- int objc; /* Additional arguments to store */
- Tcl_Obj *CONST objv[]; /* with alias. */
+ Tcl_Obj *namePtr, /* Name of alias cmd. */
+ Tcl_Obj *targetNamePtr, /* Name of target cmd. */
+ int objc, /* Additional arguments to store */
+ Tcl_Obj *CONST objv[]) /* with alias. */
{
Alias *aliasPtr;
Tcl_HashEntry *hPtr;
@@ -1444,10 +1436,10 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
if (TclPreventAliasLoop(interp, slaveInterp,
aliasPtr->slaveCmd) != TCL_OK) {
/*
- * Found an alias loop! The last call to Tcl_CreateObjCommand made
- * the alias point to itself. Delete the command and its alias
- * record. Be careful to wipe out its client data first, so the
- * command doesn't try to delete itself.
+ * Found an alias loop! The last call to Tcl_CreateObjCommand made the
+ * alias point to itself. Delete the command and its alias record. Be
+ * careful to wipe out its client data first, so the command doesn't
+ * try to delete itself.
*/
Command *cmdPtr;
@@ -1558,10 +1550,10 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
*/
static int
-AliasDelete(interp, slaveInterp, namePtr)
- Tcl_Interp *interp; /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
- Tcl_Obj *namePtr; /* Name of alias to delete. */
+AliasDelete(
+ Tcl_Interp *interp, /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Obj *namePtr) /* Name of alias to delete. */
{
Slave *slavePtr;
Alias *aliasPtr;
@@ -1604,10 +1596,10 @@ AliasDelete(interp, slaveInterp, namePtr)
*/
static int
-AliasDescribe(interp, slaveInterp, namePtr)
- Tcl_Interp *interp; /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
- Tcl_Obj *namePtr; /* Name of alias to describe. */
+AliasDescribe(
+ Tcl_Interp *interp, /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp, /* Interpreter containing alias. */
+ Tcl_Obj *namePtr) /* Name of alias to describe. */
{
Slave *slavePtr;
Tcl_HashEntry *hPtr;
@@ -1648,9 +1640,9 @@ AliasDescribe(interp, slaveInterp, namePtr)
*/
static int
-AliasList(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for data return. */
- Tcl_Interp *slaveInterp; /* Interp whose aliases to compute. */
+AliasList(
+ Tcl_Interp *interp, /* Interp for data return. */
+ Tcl_Interp *slaveInterp) /* Interp whose aliases to compute. */
{
Tcl_HashEntry *entryPtr;
Tcl_HashSearch hashSearch;
@@ -1692,11 +1684,11 @@ AliasList(interp, slaveInterp)
*/
static int
-AliasObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Alias record. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
+AliasObjCmd(
+ ClientData clientData, /* Alias record. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
Tcl_Interp *targetInterp;
@@ -1770,8 +1762,8 @@ AliasObjCmd(clientData, interp, objc, objv)
*/
static void
-AliasObjCmdDeleteProc(clientData)
- ClientData clientData; /* The alias record for this alias. */
+AliasObjCmdDeleteProc(
+ ClientData clientData) /* The alias record for this alias. */
{
Alias *aliasPtr;
Target *targetPtr;
@@ -1831,10 +1823,10 @@ AliasObjCmdDeleteProc(clientData)
*/
Tcl_Interp *
-Tcl_CreateSlave(interp, slavePath, isSafe)
- Tcl_Interp *interp; /* Interpreter to start search at. */
- CONST char *slavePath; /* Name of slave to create. */
- int isSafe; /* Should new slave be "safe" ? */
+Tcl_CreateSlave(
+ Tcl_Interp *interp, /* Interpreter to start search at. */
+ CONST char *slavePath, /* Name of slave to create. */
+ int isSafe) /* Should new slave be "safe" ? */
{
Tcl_Obj *pathPtr;
Tcl_Interp *slaveInterp;
@@ -1863,9 +1855,9 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
*/
Tcl_Interp *
-Tcl_GetSlave(interp, slavePath)
- Tcl_Interp *interp; /* Interpreter to start search from. */
- CONST char *slavePath; /* Path of slave to find. */
+Tcl_GetSlave(
+ Tcl_Interp *interp, /* Interpreter to start search from. */
+ CONST char *slavePath) /* Path of slave to find. */
{
Tcl_Obj *pathPtr;
Tcl_Interp *slaveInterp;
@@ -1894,8 +1886,8 @@ Tcl_GetSlave(interp, slavePath)
*/
Tcl_Interp *
-Tcl_GetMaster(interp)
- Tcl_Interp *interp; /* Get the master of this interpreter. */
+Tcl_GetMaster(
+ Tcl_Interp *interp) /* Get the master of this interpreter. */
{
Slave *slavePtr; /* Slave record of this interpreter. */
@@ -1931,9 +1923,9 @@ Tcl_GetMaster(interp)
*/
int
-Tcl_GetInterpPath(askingInterp, targetInterp)
- Tcl_Interp *askingInterp; /* Interpreter to start search from. */
- Tcl_Interp *targetInterp; /* Interpreter to find. */
+Tcl_GetInterpPath(
+ Tcl_Interp *askingInterp, /* Interpreter to start search from. */
+ Tcl_Interp *targetInterp) /* Interpreter to find. */
{
InterpInfo *iiPtr;
@@ -1970,9 +1962,9 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
*/
static Tcl_Interp *
-GetInterp(interp, pathPtr)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Tcl_Obj *pathPtr; /* List object containing name of interp. to
+GetInterp(
+ Tcl_Interp *interp, /* Interp. to start search from. */
+ Tcl_Obj *pathPtr) /* List object containing name of interp. to
* be found. */
{
Tcl_HashEntry *hPtr; /* Search element. */
@@ -2027,11 +2019,11 @@ GetInterp(interp, pathPtr)
*/
static int
-SlaveBgerror(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which limit is set/queried. */
- int objc; /* Set or Query. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveBgerror(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ int objc, /* Set or Query. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
if (objc) {
int length;
@@ -2068,10 +2060,10 @@ SlaveBgerror(interp, slaveInterp, objc, objv)
*/
static Tcl_Interp *
-SlaveCreate(interp, pathPtr, safe)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Tcl_Obj *pathPtr; /* Path (name) of slave to create. */
- int safe; /* Should we make it "safe"? */
+SlaveCreate(
+ Tcl_Interp *interp, /* Interp. to start search from. */
+ Tcl_Obj *pathPtr, /* Path (name) of slave to create. */
+ int safe) /* Should we make it "safe"? */
{
Tcl_Interp *masterInterp, *slaveInterp;
Slave *slavePtr;
@@ -2151,6 +2143,12 @@ SlaveCreate(interp, pathPtr, safe)
InheritLimitsFromMaster(slaveInterp, masterInterp);
+ /*
+ * The [clock] command presents a safe API, but uses unsafe features in
+ * its implementation. This means it has to be implemented in safe interps
+ * as an alias to a version in the (trusted) master.
+ */
+
if (safe) {
Tcl_Obj* clockObj = Tcl_NewStringObj("clock", -1);
int status;
@@ -2166,9 +2164,9 @@ SlaveCreate(interp, pathPtr, safe)
return slaveInterp;
- error:
+ error:
TclTransferResult(slaveInterp, TCL_ERROR, interp);
- error2:
+ error2:
Tcl_DeleteInterp(slaveInterp);
return NULL;
@@ -2192,11 +2190,11 @@ SlaveCreate(interp, pathPtr, safe)
*/
static int
-SlaveObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Slave interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveObjCmd(
+ ClientData clientData, /* Slave interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Interp *slaveInterp;
int index;
@@ -2387,11 +2385,11 @@ SlaveObjCmd(clientData, interp, objc, objv)
*/
static void
-SlaveObjCmdDeleteProc(clientData)
- ClientData clientData; /* The SlaveRecord for the command. */
+SlaveObjCmdDeleteProc(
+ ClientData clientData) /* The SlaveRecord for the command. */
{
- Slave *slavePtr; /* Interim storage for Slave record. */
- Tcl_Interp *slaveInterp; /* And for a slave interp. */
+ Slave *slavePtr; /* Interim storage for Slave record. */
+ Tcl_Interp *slaveInterp; /* And for a slave interp. */
slaveInterp = (Tcl_Interp *) clientData;
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
@@ -2404,7 +2402,7 @@ SlaveObjCmdDeleteProc(clientData)
/*
* Set to NULL so that when the InterpInfo is cleaned up in the slave it
- * does not try to delete the command causing all sorts of grief. See
+ * does not try to delete the command causing all sorts of grief. See
* SlaveRecordDeleteProc().
*/
@@ -2432,12 +2430,12 @@ SlaveObjCmdDeleteProc(clientData)
*/
static int
-SlaveEval(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter in which command
+SlaveEval(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* The slave interpreter in which command
* will be evaluated. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int result;
Tcl_Obj *objPtr;
@@ -2477,11 +2475,11 @@ SlaveEval(interp, slaveInterp, objc, objv)
*/
static int
-SlaveExpose(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveExpose(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
char *name;
@@ -2519,11 +2517,11 @@ SlaveExpose(interp, slaveInterp, objc, objv)
*/
static int
-SlaveRecursionLimit(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which limit is set/queried. */
- int objc; /* Set or Query. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveRecursionLimit(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */
+ int objc, /* Set or Query. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
Interp *iPtr;
int limit;
@@ -2577,11 +2575,11 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv)
*/
static int
-SlaveHide(interp, slaveInterp, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+SlaveHide(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
char *name;
@@ -2618,9 +2616,9 @@ SlaveHide(interp, slaveInterp, objc, objv)
*/
static int
-SlaveHidden(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for data return. */
- Tcl_Interp *slaveInterp; /* Interp whose hidden commands to query. */
+SlaveHidden(
+ Tcl_Interp *interp, /* Interp for data return. */
+ Tcl_Interp *slaveInterp) /* Interp whose hidden commands to query. */
{
Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */
Tcl_HashTable *hTblPtr; /* For local searches. */
@@ -2657,13 +2655,13 @@ SlaveHidden(interp, slaveInterp)
*/
static int
-SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter in which command will
+SlaveInvokeHidden(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* The slave interpreter in which command will
* be invoked. */
- CONST char *namespaceName; /* The namespace to use, if any. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+ CONST char *namespaceName, /* The namespace to use, if any. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int result;
@@ -2717,9 +2715,9 @@ SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv)
*/
static int
-SlaveMarkTrusted(interp, slaveInterp)
- Tcl_Interp *interp; /* Interp for error return. */
- Tcl_Interp *slaveInterp; /* The slave interpreter which will be marked
+SlaveMarkTrusted(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp) /* The slave interpreter which will be marked
* trusted. */
{
if (Tcl_IsSafe(interp)) {
@@ -2749,8 +2747,8 @@ SlaveMarkTrusted(interp, slaveInterp)
*/
int
-Tcl_IsSafe(interp)
- Tcl_Interp *interp; /* Is this interpreter "safe" ? */
+Tcl_IsSafe(
+ Tcl_Interp *interp) /* Is this interpreter "safe" ? */
{
Interp *iPtr;
@@ -2782,8 +2780,8 @@ Tcl_IsSafe(interp)
*/
int
-Tcl_MakeSafe(interp)
- Tcl_Interp *interp; /* Interpreter to be made safe. */
+Tcl_MakeSafe(
+ Tcl_Interp *interp) /* Interpreter to be made safe. */
{
Tcl_Channel chan; /* Channel to remove from safe interpreter. */
Interp *iPtr = (Interp *) interp;
@@ -2866,8 +2864,8 @@ Tcl_MakeSafe(interp)
*/
int
-Tcl_LimitExceeded(interp)
- Tcl_Interp *interp;
+Tcl_LimitExceeded(
+ Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
@@ -2893,8 +2891,8 @@ Tcl_LimitExceeded(interp)
*/
int
-Tcl_LimitReady(interp)
- Tcl_Interp *interp;
+Tcl_LimitReady(
+ Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
@@ -2921,7 +2919,7 @@ Tcl_LimitReady(interp)
* Tcl_LimitCheck --
*
* Check all currently set limits in the interpreter (where permitted by
- * granularity). If a limit is exceeded, call its callbacks and, if the
+ * granularity). If a limit is exceeded, call its callbacks and, if the
* limit is still exceeded after the callbacks have run, make the
* interpreter generate an error that cannot be caught within the limited
* interpreter.
@@ -2939,8 +2937,8 @@ Tcl_LimitReady(interp)
*/
int
-Tcl_LimitCheck(interp)
- Tcl_Interp *interp;
+Tcl_LimitCheck(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
register int ticker = iPtr->limit.granularityTicker;
@@ -3015,9 +3013,9 @@ Tcl_LimitCheck(interp)
*/
static void
-RunLimitHandlers(handlerPtr, interp)
- LimitHandler *handlerPtr;
- Tcl_Interp *interp;
+RunLimitHandlers(
+ LimitHandler *handlerPtr,
+ Tcl_Interp *interp)
{
LimitHandler *nextPtr;
for (; handlerPtr!=NULL ; handlerPtr=nextPtr) {
@@ -3043,7 +3041,7 @@ RunLimitHandlers(handlerPtr, interp)
/*
* Rediscover this value; it might have changed during the processing
- * of a limit handler. We have to record it here because we might
+ * of a limit handler. We have to record it here because we might
* delete the structure below, and reading a value out of a deleted
* structure is unsafe (even if actually legal with some
* malloc()/free() implementations.)
@@ -3083,12 +3081,12 @@ RunLimitHandlers(handlerPtr, interp)
*/
void
-Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
- Tcl_Interp *interp;
- int type;
- Tcl_LimitHandlerProc *handlerProc;
- ClientData clientData;
- Tcl_LimitHandlerDeleteProc *deleteProc;
+Tcl_LimitAddHandler(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData,
+ Tcl_LimitHandlerDeleteProc *deleteProc)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr;
@@ -3152,7 +3150,7 @@ Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
*
* Side effects:
* The handler is spliced out of the internal linked list for the limit,
- * and if not currently being invoked, deleted. Otherwise it is just
+ * and if not currently being invoked, deleted. Otherwise it is just
* marked for deletion and removed when the limit handler has finished
* executing.
*
@@ -3160,11 +3158,11 @@ Tcl_LimitAddHandler(interp, type, handlerProc, clientData, deleteProc)
*/
void
-Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
- Tcl_Interp *interp;
- int type;
- Tcl_LimitHandlerProc *handlerProc;
- ClientData clientData;
+Tcl_LimitRemoveHandler(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_LimitHandlerProc *handlerProc,
+ ClientData clientData)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr;
@@ -3219,7 +3217,7 @@ Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
@@ -3252,8 +3250,8 @@ Tcl_LimitRemoveHandler(interp, type, handlerProc, clientData)
*/
void
-TclLimitRemoveAllHandlers(interp)
- Tcl_Interp *interp;
+TclLimitRemoveAllHandlers(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
LimitHandler *handlerPtr, *nextHandlerPtr;
@@ -3279,7 +3277,7 @@ TclLimitRemoveAllHandlers(interp)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
@@ -3312,7 +3310,7 @@ TclLimitRemoveAllHandlers(interp)
/*
* If nothing is currently executing the handler, delete its client
- * data and the overall handler structure now. Otherwise it will all
+ * data and the overall handler structure now. Otherwise it will all
* go away when the handler returns.
*/
@@ -3352,9 +3350,9 @@ TclLimitRemoveAllHandlers(interp)
*/
int
-Tcl_LimitTypeEnabled(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeEnabled(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3379,9 +3377,9 @@ Tcl_LimitTypeEnabled(interp, type)
*/
int
-Tcl_LimitTypeExceeded(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeExceeded(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3407,9 +3405,9 @@ Tcl_LimitTypeExceeded(interp, type)
*/
void
-Tcl_LimitTypeSet(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeSet(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3427,7 +3425,7 @@ Tcl_LimitTypeSet(interp, type)
* None.
*
* Side effects:
- * The limit is disabled. If the limit was exceeded when this function
+ * The limit is disabled. If the limit was exceeded when this function
* was called, the limit will no longer be exceeded afterwards and the
* interpreter will be free to execute further scripts (assuming it isn't
* also deleted, of course).
@@ -3436,9 +3434,9 @@ Tcl_LimitTypeSet(interp, type)
*/
void
-Tcl_LimitTypeReset(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitTypeReset(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3457,7 +3455,7 @@ Tcl_LimitTypeReset(interp, type)
* None.
*
* Side effects:
- * Also resets whether the command limit was exceeded. This might permit
+ * Also resets whether the command limit was exceeded. This might permit
* a small amount of further execution in the interpreter even if the
* limit itself is theoretically exceeded.
*
@@ -3465,9 +3463,9 @@ Tcl_LimitTypeReset(interp, type)
*/
void
-Tcl_LimitSetCommands(interp, commandLimit)
- Tcl_Interp *interp;
- int commandLimit;
+Tcl_LimitSetCommands(
+ Tcl_Interp *interp,
+ int commandLimit)
{
Interp *iPtr = (Interp *) interp;
@@ -3493,8 +3491,8 @@ Tcl_LimitSetCommands(interp, commandLimit)
*/
int
-Tcl_LimitGetCommands(interp)
- Tcl_Interp *interp;
+Tcl_LimitGetCommands(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
@@ -3513,7 +3511,7 @@ Tcl_LimitGetCommands(interp)
* None.
*
* Side effects:
- * Also resets whether the time limit was exceeded. This might permit a
+ * Also resets whether the time limit was exceeded. This might permit a
* small amount of further execution in the interpreter even if the limit
* itself is theoretically exceeded.
*
@@ -3521,9 +3519,9 @@ Tcl_LimitGetCommands(interp)
*/
void
-Tcl_LimitSetTime(interp, timeLimitPtr)
- Tcl_Interp *interp;
- Tcl_Time *timeLimitPtr;
+Tcl_LimitSetTime(
+ Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_Time nextMoment;
@@ -3540,7 +3538,7 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
}
iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment,
TimeLimitCallback, (ClientData) interp);
- iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
+ iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
}
/*
@@ -3562,8 +3560,8 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
*/
static void
-TimeLimitCallback(clientData)
- ClientData clientData;
+TimeLimitCallback(
+ ClientData clientData)
{
Tcl_Interp *interp = (Tcl_Interp *) clientData;
@@ -3594,9 +3592,9 @@ TimeLimitCallback(clientData)
*/
void
-Tcl_LimitGetTime(interp, timeLimitPtr)
- Tcl_Interp *interp;
- Tcl_Time *timeLimitPtr;
+Tcl_LimitGetTime(
+ Tcl_Interp *interp,
+ Tcl_Time *timeLimitPtr)
{
Interp *iPtr = (Interp *) interp;
@@ -3621,10 +3619,10 @@ Tcl_LimitGetTime(interp, timeLimitPtr)
*/
void
-Tcl_LimitSetGranularity(interp, type, granularity)
- Tcl_Interp *interp;
- int type;
- int granularity;
+Tcl_LimitSetGranularity(
+ Tcl_Interp *interp,
+ int type,
+ int granularity)
{
Interp *iPtr = (Interp *) interp;
if (granularity < 1) {
@@ -3659,9 +3657,9 @@ Tcl_LimitSetGranularity(interp, type, granularity)
*/
int
-Tcl_LimitGetGranularity(interp, type)
- Tcl_Interp *interp;
- int type;
+Tcl_LimitGetGranularity(
+ Tcl_Interp *interp,
+ int type)
{
Interp *iPtr = (Interp *) interp;
@@ -3694,14 +3692,15 @@ Tcl_LimitGetGranularity(interp, type)
*/
static void
-DeleteScriptLimitCallback(clientData)
- ClientData clientData;
+DeleteScriptLimitCallback(
+ ClientData clientData)
{
- struct ScriptLimitCallback *limitCBPtr =
- (struct ScriptLimitCallback *) clientData;
+ ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *) clientData;
Tcl_DecrRefCount(limitCBPtr->scriptObj);
- Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
+ if (limitCBPtr->entryPtr != NULL) {
+ Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
+ }
ckfree((char *) limitCBPtr);
}
@@ -3710,26 +3709,25 @@ DeleteScriptLimitCallback(clientData)
*
* CallScriptLimitCallback --
*
- * Invoke a script limit callback. Used to implement limit callbacks set
+ * Invoke a script limit callback. Used to implement limit callbacks set
* at the Tcl level on child interpreters.
*
* Results:
* None.
*
* Side effects:
- * Depends on the callback script. Errors are reported as background
+ * Depends on the callback script. Errors are reported as background
* errors.
*
*----------------------------------------------------------------------
*/
static void
-CallScriptLimitCallback(clientData, interp)
- ClientData clientData;
- Tcl_Interp *interp; /* Interpreter which failed the limit */
+CallScriptLimitCallback(
+ ClientData clientData,
+ Tcl_Interp *interp) /* Interpreter which failed the limit */
{
- struct ScriptLimitCallback *limitCBPtr =
- (struct ScriptLimitCallback *) clientData;
+ ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *) clientData;
int code;
if (Tcl_InterpDeleted(limitCBPtr->interp)) {
@@ -3751,7 +3749,7 @@ CallScriptLimitCallback(clientData, interp)
*
* Install (or remove, if scriptObj is NULL) a limit callback script that
* is called when the target interpreter exceeds the type of limit
- * specified. Each interpreter may only have one callback set on another
+ * specified. Each interpreter may only have one callback set on another
* interpreter through this mechanism (though as many interpreters may be
* limited as the programmer chooses overall).
*
@@ -3766,16 +3764,16 @@ CallScriptLimitCallback(clientData, interp)
*/
static void
-SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
- Tcl_Interp *interp;
- int type;
- Tcl_Interp *targetInterp;
- Tcl_Obj *scriptObj;
+SetScriptLimitCallback(
+ Tcl_Interp *interp,
+ int type,
+ Tcl_Interp *targetInterp,
+ Tcl_Obj *scriptObj)
{
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hashPtr;
int isNew;
- struct ScriptLimitCallbackKey key;
+ ScriptLimitCallbackKey key;
Interp *iPtr = (Interp *) interp;
if (interp == targetInterp) {
@@ -3797,12 +3795,13 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
&isNew);
if (!isNew) {
+ limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hashPtr);
+ limitCBPtr->entryPtr = NULL;
Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
- Tcl_GetHashValue(hashPtr));
+ limitCBPtr);
}
- limitCBPtr = (struct ScriptLimitCallback *)
- ckalloc(sizeof(struct ScriptLimitCallback));
+ limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
limitCBPtr->interp = interp;
limitCBPtr->scriptObj = scriptObj;
limitCBPtr->entryPtr = hashPtr;
@@ -3820,7 +3819,7 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
* TclRemoveScriptLimitCallbacks --
*
* Remove all script-implemented limit callbacks that make calls back
- * into the given interpreter. This invoked as part of deleting an
+ * into the given interpreter. This invoked as part of deleting an
* interpreter.
*
* Results:
@@ -3833,17 +3832,17 @@ SetScriptLimitCallback(interp, type, targetInterp, scriptObj)
*/
void
-TclRemoveScriptLimitCallbacks(interp)
- Tcl_Interp *interp;
+TclRemoveScriptLimitCallbacks(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hashPtr;
Tcl_HashSearch search;
- struct ScriptLimitCallbackKey *keyPtr;
+ ScriptLimitCallbackKey *keyPtr;
hashPtr = Tcl_FirstHashEntry(&iPtr->limit.callbacks, &search);
while (hashPtr != NULL) {
- keyPtr = (struct ScriptLimitCallbackKey *)
+ keyPtr = (ScriptLimitCallbackKey *)
Tcl_GetHashKey(&iPtr->limit.callbacks, hashPtr);
Tcl_LimitRemoveHandler(keyPtr->interp, keyPtr->type,
CallScriptLimitCallback, Tcl_GetHashValue(hashPtr));
@@ -3858,7 +3857,7 @@ TclRemoveScriptLimitCallbacks(interp)
* TclInitLimitSupport --
*
* Initialise all the parts of the interpreter relating to resource limit
- * management. This allows an interpreter to both have limits set upon
+ * management. This allows an interpreter to both have limits set upon
* itself and set limits upon other interpreters.
*
* Results:
@@ -3871,8 +3870,8 @@ TclRemoveScriptLimitCallbacks(interp)
*/
void
-TclInitLimitSupport(interp)
- Tcl_Interp *interp;
+TclInitLimitSupport(
+ Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
@@ -3887,7 +3886,7 @@ TclInitLimitSupport(interp)
iPtr->limit.timeEvent = NULL;
iPtr->limit.timeGranularity = 10;
Tcl_InitHashTable(&iPtr->limit.callbacks,
- sizeof(struct ScriptLimitCallbackKey)/sizeof(int));
+ sizeof(ScriptLimitCallbackKey)/sizeof(int));
}
/*
@@ -3911,8 +3910,9 @@ TclInitLimitSupport(interp)
*/
static void
-InheritLimitsFromMaster(slaveInterp, masterInterp)
- Tcl_Interp *slaveInterp, *masterInterp;
+InheritLimitsFromMaster(
+ Tcl_Interp *slaveInterp,
+ Tcl_Interp *masterInterp)
{
Interp *slavePtr = (Interp *) slaveInterp;
Interp *masterPtr = (Interp *) masterInterp;
@@ -3936,7 +3936,7 @@ InheritLimitsFromMaster(slaveInterp, masterInterp)
* SlaveCommandLimitCmd --
*
* Implementation of the [interp limit $i commands] and [$i limit
- * commands] subcommands. See the interp manual page for a full
+ * commands] subcommands. See the interp manual page for a full
* description.
*
* Results:
@@ -3949,12 +3949,12 @@ InheritLimitsFromMaster(slaveInterp, masterInterp)
*/
static int
-SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* Interpreter being adjusted. */
- int consumedObjc; /* Number of args already parsed. */
- int objc; /* Total number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveCommandLimitCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ int consumedObjc, /* Number of args already parsed. */
+ int objc, /* Total number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
static CONST char *options[] = {
"-command", "-granularity", "-value", NULL
@@ -3964,8 +3964,8 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
};
Interp *iPtr = (Interp *) interp;
int index;
- struct ScriptLimitCallbackKey key;
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallbackKey key;
+ ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
if (objc == consumedObjc) {
@@ -3976,8 +3976,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
limitCBPtr->scriptObj);
@@ -4019,8 +4018,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_COMMANDS;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
}
@@ -4110,7 +4108,7 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
* SlaveTimeLimitCmd --
*
* Implementation of the [interp limit $i time] and [$i limit time]
- * subcommands. See the interp manual page for a full description.
+ * subcommands. See the interp manual page for a full description.
*
* Results:
* A standard Tcl result.
@@ -4122,12 +4120,12 @@ SlaveCommandLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
*/
static int
-SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* Interpreter being adjusted. */
- int consumedObjc; /* Number of args already parsed. */
- int objc; /* Total number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+SlaveTimeLimitCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */
+ int consumedObjc, /* Number of args already parsed. */
+ int objc, /* Total number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
static CONST char *options[] = {
"-command", "-granularity", "-milliseconds", "-seconds", NULL
@@ -4137,8 +4135,8 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
};
Interp *iPtr = (Interp *) interp;
int index;
- struct ScriptLimitCallbackKey key;
- struct ScriptLimitCallback *limitCBPtr;
+ ScriptLimitCallbackKey key;
+ ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
if (objc == consumedObjc) {
@@ -4149,8 +4147,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
limitCBPtr->scriptObj);
@@ -4198,8 +4195,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
key.type = TCL_LIMIT_TIME;
hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
if (hPtr != NULL) {
- limitCBPtr = (struct ScriptLimitCallback *)
- Tcl_GetHashValue(hPtr);
+ limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
}
@@ -4300,7 +4296,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (milliObj != NULL) {
/*
* Setting -milliseconds but clearing -seconds, or resetting
- * -milliseconds but not resetting -seconds? Bad voodoo!
+ * -milliseconds but not resetting -seconds? Bad voodoo!
*/
if (secObj != NULL && secLen == 0 && milliLen > 0) {
@@ -4318,7 +4314,7 @@ SlaveTimeLimitCmd(interp, slaveInterp, consumedObjc, objc, objv)
if (milliLen > 0 || secLen > 0) {
/*
* Force usec to be in range [0..1000000), possibly
- * incrementing sec in the process. This makes it much easier
+ * incrementing sec in the process. This makes it much easier
* for people to write scripts that do small time increments.
*/
diff --git a/tests/interp.test b/tests/interp.test
index f801247..d2acbdd 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.46 2005/06/17 14:26:15 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.47 2005/10/10 17:33:26 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -25,8 +25,6 @@ foreach i [interp slaves] {
interp delete $i
}
-proc equiv {x} {return $x}
-
# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} {
list [catch {interp} msg] $msg
@@ -379,7 +377,7 @@ test interp-10.7 {testing aliases between interpreters} {
set x [foo 33]
a eval {rename zoppo {}}
interp alias "" foo a {}
- equiv $x
+ return $x
} {33 33 33}
# Part 10: Testing "interp target"
@@ -3113,6 +3111,64 @@ test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
interp delete $i
lappend result $msg
} -result {1 {time limit exceeded}}
+test interp-34.11 {time limit extension in callbacks} -setup {
+ proc cb1 {i t} {
+ global result
+ lappend result cb1
+ $i limit time -seconds $t -command cb2
+ }
+ proc cb2 {} {
+ global result
+ lappend result cb2
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 \
+ -command "cb1 $i [expr {$t0+2}]"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup {
+ rename cb1 {}
+ rename cb2 {}
+}
+test interp-34.12 {time limit extension in callbacks} -setup {
+ proc cb1 {i} {
+ global result times
+ lappend result cb1
+ set times [lassign $times t]
+ $i limit time -seconds $t
+ }
+} -body {
+ set i [interp create]
+ set t0 [clock seconds]
+ set ::times "[expr {$t0+2}] [expr {$t0+100}]"
+ $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
+ set ::result {}
+ lappend ::result [catch {
+ $i eval {
+ for {set i 0} {$i<30} {incr i} {
+ after 100
+ }
+ }
+ } msg] $msg
+ set t1 [clock seconds]
+ lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ interp delete $i
+ return $::result
+} -result {cb1 cb1 0 {} ok} -cleanup {
+ rename cb1 {}
+}
test interp-35.1 {interp limit syntax} -body {
interp limit