summaryrefslogtreecommitdiffstats
path: root/generic/tclTestProcBodyObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestProcBodyObj.c')
-rw-r--r--generic/tclTestProcBodyObj.c97
1 files changed, 49 insertions, 48 deletions
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 644179b..0d3617e 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -11,6 +11,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
@@ -31,9 +34,8 @@ static const char procCommand[] = "proc";
* procs
*/
-typedef struct CmdTable
-{
- const char *cmdName; /* command name */
+typedef struct CmdTable {
+ const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
@@ -43,24 +45,22 @@ typedef struct CmdTable
*/
static int ProcBodyTestProcObjCmd(ClientData dummy,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ 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 }
};
@@ -70,13 +70,13 @@ static CONST CmdTable safeCommands[] = {
*
* Procbodytest_Init --
*
- * This function initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -84,7 +84,7 @@ static CONST CmdTable safeCommands[] = {
int
Procbodytest_Init(
Tcl_Interp *interp) /* the Tcl interpreter for which the package
- * is initialized */
+ * is initialized */
{
return ProcBodyTestInitInternal(interp, 0);
}
@@ -94,13 +94,13 @@ Procbodytest_Init(
*
* Procbodytest_SafeInit --
*
- * This function initializes the "procbodytest" package.
+ * This function initializes the "procbodytest" package.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -108,7 +108,7 @@ Procbodytest_Init(
int
Procbodytest_SafeInit(
Tcl_Interp *interp) /* the Tcl interpreter for which the package
- * is initialized */
+ * is initialized */
{
return ProcBodyTestInitInternal(interp, 1);
}
@@ -118,36 +118,38 @@ Procbodytest_SafeInit(
*
* RegisterCommand --
*
- * This function 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.
+ * A standard Tcl result.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int RegisterCommand(interp, namespace, cmdTablePtr)
- Tcl_Interp* interp; /* the Tcl interpreter for which the operation
+static int
+RegisterCommand(
+ Tcl_Interp* interp, /* the Tcl interpreter for which the operation
* is performed */
- const char *namespace; /* the namespace in which the command is
+ const char *namespace, /* the namespace in which the command is
* registered */
- const CmdTable *cmdTablePtr;/* the command to register */
+ const CmdTable *cmdTablePtr)/* the command to register */
{
char buf[128];
if (cmdTablePtr->exportIt) {
- sprintf(buf, "namespace eval %s { namespace export %s }",
- namespace, cmdTablePtr->cmdName);
- if (Tcl_Eval(interp, buf) != TCL_OK)
- return TCL_ERROR;
+ sprintf(buf, "namespace eval %s { namespace export %s }",
+ namespace, cmdTablePtr->cmdName);
+ 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);
-
return TCL_OK;
}
@@ -171,16 +173,16 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
static int
ProcBodyTestInitInternal(
Tcl_Interp *interp, /* the Tcl interpreter for which the package
- * is initialized */
+ * is initialized */
int isSafe) /* 1 if this is a safe interpreter */
{
- CONST CmdTable *cmdTablePtr;
+ const CmdTable *cmdTablePtr;
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
- if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
return Tcl_PkgProvide(interp, packageName, packageVersion);
@@ -226,7 +228,7 @@ ProcBodyTestProcObjCmd(
int objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
- char *fullName;
+ const char *fullName;
Tcl_Command procCmd;
Command *cmdPtr;
Proc *procPtr = NULL;
@@ -243,23 +245,23 @@ ProcBodyTestProcObjCmd(
* Find the Command pointer to this procedure
*/
- fullName = Tcl_GetStringFromObj(objv[3], NULL);
+ fullName = Tcl_GetString(objv[3]);
procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
if (procCmd == NULL) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
cmdPtr = (Command *) procCmd;
/*
* check that this is a procedure and not a builtin command:
- * If a procedure, cmdPtr->objProc is TclObjInterpProc.
+ * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
*/
- if (cmdPtr->objProc != TclGetObjInterpProc()) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ if (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"command \"", fullName, "\" is not a Tcl procedure", NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -268,10 +270,9 @@ ProcBodyTestProcObjCmd(
procPtr = (Proc *) cmdPtr->objClientData;
if (procPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "procedure \"", fullName,
- "\" does not have a Proc struct!", NULL);
- return TCL_ERROR;
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"",
+ fullName, "\" does not have a Proc struct!", NULL);
+ return TCL_ERROR;
}
/*
@@ -280,10 +281,10 @@ ProcBodyTestProcObjCmd(
bodyObjPtr = TclNewProcBodyObj(procPtr);
if (bodyObjPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"failed to create a procbody object for procedure \"",
- fullName, "\"", NULL);
- return TCL_ERROR;
+ fullName, "\"", NULL);
+ return TCL_ERROR;
}
Tcl_IncrRefCount(bodyObjPtr);
@@ -293,7 +294,7 @@ ProcBodyTestProcObjCmd(
myobjv[3] = bodyObjPtr;
myobjv[4] = NULL;
- result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
+ result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
Tcl_DecrRefCount(bodyObjPtr);
return result;
generated by cgit v0.12 at 2024-11-20 02:32:31 (GMT)