Move testgetencpath/testsetencpath test commands from UNIX-specific to general. Rewrite a few other commands (like "memory") to use the Tcl_Obj interface.

2 files changed, 133 insertions, 61 deletions

diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index d7604fa..8746241 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -131,10 +131,12 @@ static int ckallocInit = 0;
  * Prototypes for procedures defined in this file:
  */
 
-static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
-			    int argc, const char *argv[]);
-static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
-			    int argc, const char *argv[]);
+static int		CheckmemCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		MemoryCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static void		ValidateMemory(struct mem_header *memHeaderP,
 			    const char *file, int line, int nukeGuards);
 
@@ -811,8 +813,8 @@ static int
 MemoryCmd(
     ClientData clientData,
     Tcl_Interp *interp,
-    int argc,
-    const char *argv[])
+    int objc,			/* Number of arguments. */
+	Tcl_Obj *const objv[])		/* Obj values of arguments. */
 {
     const char *fileName;
     FILE *fileP;
@@ -820,20 +822,17 @@ MemoryCmd(
     int result;
     size_t len;
 
-    if (argc < 2) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "wrong # args: should be \"%s option [args..]\"", argv[0]));
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option [args..]");
 	return TCL_ERROR;
     }
 
-    if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
-	if (argc != 3) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "wrong # args: should be \"%s %s file\"",
-                    argv[0], argv[1]));
+    if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "file");
 	    return TCL_ERROR;
 	}
-	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
 	if (fileName == NULL) {
 	    return TCL_ERROR;
 	}
@@ -841,23 +840,23 @@ MemoryCmd(
 	Tcl_DStringFree(&buffer);
 	if (result != TCL_OK) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
-                    argv[2], Tcl_PosixError(interp)));
+                    TclGetString(objv[2]), Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"break_on_malloc") == 0) {
+    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
 	int value;
-	if (argc != 3) {
+	if (objc != 3) {
 	    goto argError;
 	}
-	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	break_on_malloc = (unsigned int) value;
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"info") == 0) {
+    if (strcmp(TclGetString(objv[1]),"info") == 0) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
 		"total mallocs", total_mallocs, "total frees", total_frees,
@@ -867,20 +866,19 @@ MemoryCmd(
 		"maximum bytes allocated", maximum_bytes_malloced));
 	return TCL_OK;
     }
-    if (strcmp(argv[1], "init") == 0) {
-	if (argc != 3) {
+    if (strcmp(TclGetString(objv[1]), "init") == 0) {
+	if (objc != 3) {
 	    goto bad_suboption;
 	}
-	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
 	return TCL_OK;
     }
-    if (strcmp(argv[1], "objs") == 0) {
-	if (argc != 3) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "wrong # args: should be \"%s objs file\"", argv[0]));
+    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "file");
 	    return TCL_ERROR;
 	}
-	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
 	if (fileName == NULL) {
 	    return TCL_ERROR;
 	}
@@ -896,13 +894,12 @@ MemoryCmd(
 	Tcl_DStringFree(&buffer);
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"onexit") == 0) {
-	if (argc != 3) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "wrong # args: should be \"%s onexit file\"", argv[0]));
+    if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "file");
 	    return TCL_ERROR;
 	}
-	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
 	if (fileName == NULL) {
 	    return TCL_ERROR;
 	}
@@ -911,62 +908,59 @@ MemoryCmd(
 	Tcl_DStringFree(&buffer);
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"tag") == 0) {
-	if (argc != 3) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "wrong # args: should be \"%s tag string\"", argv[0]));
+    if (strcmp(TclGetString(objv[1]),"tag") == 0) {
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "file");
 	    return TCL_ERROR;
 	}
 	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
 	    TclpFree((char *) curTagPtr);
 	}
-	len = strlen(argv[2]);
+	len = strlen(TclGetString(objv[2]));
 	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
 	curTagPtr->refCount = 0;
-	memcpy(curTagPtr->string, argv[2], len + 1);
+	memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"trace") == 0) {
-	if (argc != 3) {
+    if (strcmp(TclGetString(objv[1]),"trace") == 0) {
+	if (objc != 3) {
 	    goto bad_suboption;
 	}
-	alloc_tracing = (strcmp(argv[2],"on") == 0);
+	alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
 	return TCL_OK;
     }
 
-    if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+    if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
 	int value;
-	if (argc != 3) {
+	if (objc != 3) {
 	    goto argError;
 	}
-	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	trace_on_at_malloc = value;
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"validate") == 0) {
-	if (argc != 3) {
+    if (strcmp(TclGetString(objv[1]),"validate") == 0) {
+	if (objc != 3) {
 	    goto bad_suboption;
 	}
-	validate_memory = (strcmp(argv[2],"on") == 0);
+	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
 	return TCL_OK;
     }
 
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
             "bad option \"%s\": should be active, break_on_malloc, info, "
             "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
-            argv[1]));
+            TclGetString(objv[1])));
     return TCL_ERROR;
 
   argError:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-            "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
+    Tcl_WrongNumArgs(interp, 2, objv, "count");
     return TCL_ERROR;
 
   bad_suboption:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-            "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
+    Tcl_WrongNumArgs(interp, 2, objv, "on|off");
     return TCL_ERROR;
 }
 
@@ -987,21 +981,23 @@ MemoryCmd(
  *
  *----------------------------------------------------------------------
  */
+static int		CheckmemCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 
 static int
 CheckmemCmd(
     ClientData clientData,	/* Not used. */
     Tcl_Interp *interp,		/* Interpreter for evaluation. */
-    int argc,			/* Number of arguments. */
-    const char *argv[])		/* String values of arguments. */
+    int objc,			/* Number of arguments. */
+	Tcl_Obj *const objv[])		/* Obj values of arguments. */
 {
-    if (argc != 2) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "wrong # args: should be \"%s fileName\"", argv[0]));
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
 	return TCL_ERROR;
     }
     tclMemDumpFileName = dumpFile;
-    strcpy(tclMemDumpFileName, argv[1]);
+    strcpy(tclMemDumpFileName, TclGetString(objv[1]));
     return TCL_OK;
 }
 
@@ -1027,8 +1023,8 @@ Tcl_InitMemory(
 				 * added */
 {
     TclInitDbCkalloc();
-    Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
 }
 
 
diff --git a/generic/tclTest.c b/generic/tclTest.c
index bfaaf56..61c88ba 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -387,6 +387,12 @@ static int		TestSimpleFilesystemObjCmd(
 			    Tcl_Obj *const objv[]);
 static void		TestReport(const char *cmd, Tcl_Obj *arg1,
 			    Tcl_Obj *arg2);
+static int		TestgetencpathObjCmd(void *dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestsetencpathObjCmd(void *dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static Tcl_Obj *	TestReportGetNativePath(Tcl_Obj *pathPtr);
 static Tcl_FSStatProc TestReportStat;
 static Tcl_FSAccessProc TestReportAccess;
@@ -731,6 +737,10 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd,
+	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
+	    NULL, NULL);
 
     if (TclObjTest_Init(interp) != TCL_OK) {
 	return TCL_ERROR;
@@ -7541,6 +7551,72 @@ TestconcatobjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestgetencpathObjCmd --
+ *
+ *	This function implements the "testgetencpath" command. It is used to
+ *	test Tcl_GetEncodingSearchPath().
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetencpathObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)		/* Argument strings. */
+{
+    if (objc != 1) {
+        Tcl_WrongNumArgs(interp, 1, objv, "");
+        return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetencpathCmd --
+ *
+ *	This function implements the "testsetencpath" command. It is used to
+ *	test Tcl_SetDefaultEncodingDir().
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetencpathObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Argument strings. */
+{
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
+        return TCL_ERROR;
+    }
+
+    Tcl_SetEncodingSearchPath(objv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestparseargsCmd --
  *
  *	This procedure implements the "testparseargs" command. It is used to