diff options
Diffstat (limited to 'generic/tclTestProcBodyObj.c')
| -rw-r--r-- | generic/tclTestProcBodyObj.c | 135 |
1 files changed, 63 insertions, 72 deletions
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index c85b303..644179b 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" @@ -17,14 +17,14 @@ * name and version of this package */ -static CONST char packageName[] = "procbodytest"; -static CONST char packageVersion[] = "1.0"; +static const char packageName[] = "procbodytest"; +static const char packageVersion[] = "1.0"; /* * Name of the commands exported by this package */ -static CONST char procCommand[] = "proc"; +static const char procCommand[] = "proc"; /* * this struct describes an entry in the table of command names and command @@ -33,7 +33,7 @@ static CONST char procCommand[] = "proc"; typedef struct CmdTable { - CONST char *cmdName; /* command name */ + const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ } CmdTable; @@ -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, - CONST 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, + const 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 */ - CONST 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 */ + const 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: + */ |