summaryrefslogtreecommitdiffstats
path: root/generic/tclTestProcBodyObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestProcBodyObj.c')
-rw-r--r--generic/tclTestProcBodyObj.c127
1 files changed, 59 insertions, 68 deletions
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 5a17260..88bd1c3 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -1,14 +1,14 @@
-/*
+/*
* tclTestProcBodyObj.c --
*
- * Implements the "procbodytest" package, which contains commands
- * to test creation of Tcl procedures whose body argument is a
- * Tcl_Obj of type "procbody" rather than a string.
+ * Implements the "procbodytest" package, which contains commands to test
+ * creation of Tcl procedures whose body argument is a Tcl_Obj of type
+ * "procbody" rather than a string.
*
* Copyright (c) 1998 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
@@ -42,31 +42,26 @@ typedef struct CmdTable
* Declarations for functions defined in this file.
*/
-static int ProcBodyTestProcObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-static int ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
- int isSafe));
-static int RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
- char *namespace, CONST CmdTable *cmdTablePtr));
-int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp));
-int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+static int ProcBodyTestProcObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
+static int RegisterCommand(Tcl_Interp* interp,
+ char *namespace, CONST CmdTable *cmdTablePtr);
+int Procbodytest_Init(Tcl_Interp * interp);
+int Procbodytest_SafeInit(Tcl_Interp * interp);
/*
* List of commands to create when the package is loaded; must go after the
* declarations of the enable command procedure.
*/
-static CONST CmdTable commands[] =
-{
+static CONST CmdTable commands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
-
{ 0, 0, 0 }
};
-static CONST CmdTable safeCommands[] =
-{
+static CONST CmdTable safeCommands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
-
{ 0, 0, 0 }
};
@@ -75,7 +70,7 @@ static CONST CmdTable safeCommands[] =
*
* Procbodytest_Init --
*
- * This procedure initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
* A standard Tcl result.
@@ -87,8 +82,8 @@ static CONST CmdTable safeCommands[] =
*/
int
-Procbodytest_Init(interp)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
+Procbodytest_Init(
+ Tcl_Interp *interp) /* the Tcl interpreter for which the package
* is initialized */
{
return ProcBodyTestInitInternal(interp, 0);
@@ -99,7 +94,7 @@ Procbodytest_Init(interp)
*
* Procbodytest_SafeInit --
*
- * This procedure initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
* A standard Tcl result.
@@ -111,8 +106,8 @@ Procbodytest_Init(interp)
*/
int
-Procbodytest_SafeInit(interp)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
+Procbodytest_SafeInit(
+ Tcl_Interp *interp) /* the Tcl interpreter for which the package
* is initialized */
{
return ProcBodyTestInitInternal(interp, 1);
@@ -123,7 +118,7 @@ Procbodytest_SafeInit(interp)
*
* RegisterCommand --
*
- * This procedure registers a command in the context of the given namespace.
+ * This function registers a command in the context of the given namespace.
*
* Results:
* A standard Tcl result.
@@ -135,11 +130,11 @@ Procbodytest_SafeInit(interp)
*/
static int RegisterCommand(interp, namespace, cmdTablePtr)
- Tcl_Interp* interp; /* the Tcl interpreter for which the
- * operation is performed */
- char *namespace; /* the namespace in which the command
- * is registered */
- CONST CmdTable *cmdTablePtr; /* the command to register */
+ Tcl_Interp* interp; /* the Tcl interpreter for which the operation
+ * is performed */
+ char *namespace; /* the namespace in which the command is
+ * registered */
+ CONST CmdTable *cmdTablePtr;/* the command to register */
{
char buf[128];
@@ -149,7 +144,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
if (Tcl_Eval(interp, buf) != TCL_OK)
return TCL_ERROR;
}
-
+
sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
@@ -161,7 +156,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
*
* ProcBodyTestInitInternal --
*
- * This procedure initializes the Loader package.
+ * This function initializes the Loader package.
* The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
*
* Results:
@@ -174,10 +169,10 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
*/
static int
-ProcBodyTestInitInternal(interp, isSafe)
- Tcl_Interp *interp; /* the Tcl interpreter for which the package
+ProcBodyTestInitInternal(
+ Tcl_Interp *interp, /* the Tcl interpreter for which the package
* is initialized */
- int isSafe; /* 1 if this is a safe interpreter */
+ int isSafe) /* 1 if this is a safe interpreter */
{
CONST CmdTable *cmdTablePtr;
@@ -187,7 +182,7 @@ ProcBodyTestInitInternal(interp, isSafe)
return TCL_ERROR;
}
}
-
+
return Tcl_PkgProvide(interp, packageName, packageVersion);
}
@@ -225,20 +220,20 @@ ProcBodyTestInitInternal(interp, isSafe)
*/
static int
-ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
- ClientData dummy; /* context; not used */
- Tcl_Interp *interp; /* the current interpreter */
- int objc; /* argument count */
- Tcl_Obj *CONST objv[]; /* arguments */
+ProcBodyTestProcObjCmd(
+ ClientData dummy, /* context; not used */
+ Tcl_Interp *interp, /* the current interpreter */
+ int objc, /* argument count */
+ Tcl_Obj *const objv[]) /* arguments */
{
char *fullName;
Tcl_Command procCmd;
Command *cmdPtr;
- Proc *procPtr = (Proc *) NULL;
+ Proc *procPtr = NULL;
Tcl_Obj *bodyObjPtr;
Tcl_Obj *myobjv[5];
int result;
-
+
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
return TCL_ERROR;
@@ -247,10 +242,9 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
/*
* Find the Command pointer to this procedure
*/
-
- fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
- procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
- TCL_LEAVE_ERR_MSG);
+
+ fullName = Tcl_GetStringFromObj(objv[3], NULL);
+ procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
if (procCmd == NULL) {
return TCL_ERROR;
}
@@ -259,38 +253,27 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
/*
* check that this is a procedure and not a builtin command:
- * If a procedure, cmdPtr->objProc is either 0 or TclObjInterpProc,
- * and cmdPtr->proc is either 0 or TclProcInterpProc.
- * Also, the compile proc should be 0, but we don't check for that.
+ * If a procedure, cmdPtr->objProc is TclObjInterpProc.
*/
- if (((cmdPtr->objProc != NULL)
- && (cmdPtr->objProc != TclGetObjInterpProc()))
- || ((cmdPtr->proc != NULL)
- && (cmdPtr->proc != TclGetInterpProc()))) {
+ if (cmdPtr->objProc != TclGetObjInterpProc()) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "command \"", fullName,
- "\" is not a Tcl procedure", (char *) NULL);
+ "command \"", fullName, "\" is not a Tcl procedure", NULL);
return TCL_ERROR;
}
/*
* it is a Tcl procedure: the client data is the Proc structure
*/
-
- if (cmdPtr->objProc != NULL) {
- procPtr = (Proc *) cmdPtr->objClientData;
- } else if (cmdPtr->proc != NULL) {
- procPtr = (Proc *) cmdPtr->clientData;
- }
+ procPtr = (Proc *) cmdPtr->objClientData;
if (procPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"procedure \"", fullName,
- "\" does not have a Proc struct!", (char *) NULL);
+ "\" does not have a Proc struct!", NULL);
return TCL_ERROR;
}
-
+
/*
* create a new object, initialize our argument vector, call into Tcl
*/
@@ -299,7 +282,7 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
if (bodyObjPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"failed to create a procbody object for procedure \"",
- fullName, "\"", (char *) NULL);
+ fullName, "\"", NULL);
return TCL_ERROR;
}
Tcl_IncrRefCount(bodyObjPtr);
@@ -308,10 +291,18 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv)
myobjv[1] = objv[1];
myobjv[2] = objv[2];
myobjv[3] = bodyObjPtr;
- myobjv[4] = (Tcl_Obj *) NULL;
+ myobjv[4] = NULL;
result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
Tcl_DecrRefCount(bodyObjPtr);
return result;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */