Tcl 8.3 upgradeTCL_8_3

1 files changed, 33 insertions, 31 deletions

diff --git a/tcl/unix/dltest/pkga.c b/tcl/unix/dltest/pkga.c
index ab485229b41..aae4c3a1ae1 100644
--- a/tcl/unix/dltest/pkga.c
+++ b/tcl/unix/dltest/pkga.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: @(#) pkga.c 1.4 96/02/15 12:30:35
+ * RCS: @(#) $Id$
  */
 #include "tcl.h"
 
@@ -17,15 +17,15 @@
  * Prototypes for procedures defined later in this file:
  */
 
-static int	Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
-static int	Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
-		    Tcl_Interp *interp, int argc, char **argv));
+static int    Pkga_EqObjCmd _ANSI_ARGS_((ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int    Pkga_QuoteObjCmd _ANSI_ARGS_((ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
 
 /*
  *----------------------------------------------------------------------
  *
- * Pkga_EqCmd --
+ * Pkga_EqObjCmd --
  *
  *	This procedure is invoked to process the "pkga_eq" Tcl command.
  *	It expects two arguments and returns 1 if they are the same,
@@ -41,30 +41,28 @@ static int	Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
  */
 
 static int
-Pkga_EqCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+Pkga_EqObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj * CONST objv[];	/* Argument objects. */
 {
-    if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" string1 string2\"", (char *) NULL);
+    int result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
 	return TCL_ERROR;
     }
 
-    if (strcmp(argv[1], argv[2]) == 0) {
-	interp->result = "1";
-    } else {
-	interp->result = "0";
-    }
+    result = !strcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]));
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Pkga_quoteCmd --
+ * Pkga_QuoteObjCmd --
  *
  *	This procedure is invoked to process the "pkga_quote" Tcl command.
  *	It expects one argument, which it returns as result.
@@ -79,18 +77,17 @@ Pkga_EqCmd(dummy, interp, argc, argv)
  */
 
 static int
-Pkga_QuoteCmd(dummy, interp, argc, argv)
+Pkga_QuoteObjCmd(dummy, interp, objc, objv)
     ClientData dummy;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;                         /* Number of arguments. */
+    Tcl_Obj * CONST objv[];           /* Argument strings. */
 {
-    if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" value\"", (char *) NULL);
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value");
 	return TCL_ERROR;
     }
-    strcpy(interp->result, argv[1]);
+    Tcl_SetObjResult(interp, objv[1]);
     return TCL_OK;
 }
 
@@ -118,13 +115,18 @@ Pkga_Init(interp)
 {
     int code;
 
+    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+	return TCL_ERROR;
+    }
     code = Tcl_PkgProvide(interp, "Pkga", "1.0");
     if (code != TCL_OK) {
 	return code;
     }
-    Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,
-	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
+
+