1 files changed, 103 insertions, 95 deletions

diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index a3f89f6..c85b303 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -1,41 +1,39 @@
-/*
+/* 
  * 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.
  */
 
-#ifndef USE_TCL_STUBS
-#   define USE_TCL_STUBS
-#endif
 #include "tclInt.h"
 
 /*
  * 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
  * 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;
@@ -44,24 +42,31 @@ typedef struct CmdTable {
  * Declarations for functions defined in this file.
  */
 
-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);
+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));
 
 /*
  * 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,21 +75,21 @@ static const CmdTable safeCommands[] = {
  *
  * Procbodytest_Init --
  *
- *	This function initializes the "procbodytest" package.
+ *  This procedure initializes the "procbodytest" package.
  *
  * Results:
- *	A standard Tcl result.
+ *  A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Procbodytest_Init(
-    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-				 * is initialized */
+Procbodytest_Init(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 0);
 }
@@ -94,21 +99,21 @@ Procbodytest_Init(
  *
  * Procbodytest_SafeInit --
  *
- *	This function initializes the "procbodytest" package.
+ *  This procedure initializes the "procbodytest" package.
  *
  * Results:
- *	A standard Tcl result.
+ *  A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Procbodytest_SafeInit(
-    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-				 * is initialized */
+Procbodytest_SafeInit(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 1);
 }
@@ -118,38 +123,36 @@ Procbodytest_SafeInit(
  *
  * RegisterCommand --
  *
- *	This function registers a command in the context of the given
- *	namespace.
+ *  This procedure 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(
-    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 */
+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 */
 {
     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;
 }
 
@@ -158,7 +161,7 @@ RegisterCommand(
  *
  * ProcBodyTestInitInternal --
  *
- *  This function initializes the Loader package.
+ *  This procedure initializes the Loader package.
  *  The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
  *
  * Results:
@@ -171,20 +174,20 @@ RegisterCommand(
  */
 
 static int
-ProcBodyTestInitInternal(
-    Tcl_Interp *interp,		/* the Tcl interpreter for which the package
-				 * is initialized */
-    int isSafe)			/* 1 if this is a safe interpreter */
+ProcBodyTestInitInternal(interp, isSafe)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * 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);
 }
 
@@ -222,20 +225,20 @@ ProcBodyTestInitInternal(
  */
 
 static int
-ProcBodyTestProcObjCmd(
-    ClientData dummy,		/* context; not used */
-    Tcl_Interp *interp,		/* the current interpreter */
-    int objc,			/* argument count */
-    Tcl_Obj *const objv[])	/* arguments */
+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 */
 {
-    const char *fullName;
+    char *fullName;
     Tcl_Command procCmd;
     Command *cmdPtr;
-    Proc *procPtr = NULL;
+    Proc *procPtr = (Proc *) NULL;
     Tcl_Obj *bodyObjPtr;
     Tcl_Obj *myobjv[5];
     int result;
-
+    
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
 	return TCL_ERROR;
@@ -244,47 +247,60 @@ ProcBodyTestProcObjCmd(
     /*
      * Find the Command pointer to this procedure
      */
-
-    fullName = Tcl_GetStringFromObj(objv[3], NULL);
-    procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
+    
+    fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+    procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) 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->objClientData is TclIsProc(cmdPtr).
+     * 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 (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"command \"", fullName, "\" is not a Tcl procedure", NULL);
-	return TCL_ERROR;
+    if (((cmdPtr->objProc != NULL)
+            && (cmdPtr->objProc != TclGetObjInterpProc()))
+            || ((cmdPtr->proc != NULL)
+                    && (cmdPtr->proc != TclGetInterpProc()))) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"command \"", fullName,
+		"\" is not a Tcl procedure", (char *) 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!", NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"procedure \"", fullName,
+		"\" does not have a Proc struct!", (char *) NULL);
+        return TCL_ERROR;
     }
-
+        
     /*
      * create a new object, initialize our argument vector, call into Tcl
      */
 
     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, "\"", (char *) NULL);
+        return TCL_ERROR;
     }
     Tcl_IncrRefCount(bodyObjPtr);
 
@@ -292,18 +308,10 @@ ProcBodyTestProcObjCmd(
     myobjv[1] = objv[1];
     myobjv[2] = objv[2];
     myobjv[3] = bodyObjPtr;
-    myobjv[4] = NULL;
+    myobjv[4] = (Tcl_Obj *) NULL;
 
-    result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
+    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:
- */