From a416ef038cf5bc87716558a4dce7b163ebcd6697 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 12 Jun 2007 12:33:57 +0000
Subject: Convert [info] into an ensemble command.

---
 ChangeLog            |   4 +
 generic/tclBasic.c   |  10 +-
 generic/tclCmdIL.c   | 328 +++++++++++++++++--------------------
 generic/tclInt.h     |   6 +-
 tests/info.test      | 453 ++++++++++++++++++++++++++-------------------------
 tests/namespace.test |   9 +-
 tests/trace.test     |   4 +-
 7 files changed, 392 insertions(+), 422 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3a71b72..5b4874b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2007-06-12  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclBasic.c (Tcl_CreateInterp): Turn the [info] command into
+	* generic/tclCmdIL.c (TclInitInfoCmd):	 an ensemble, making it easier
+	for third-party code to plug into.
+
 	* generic/tclIndexObj.c (Tcl_WrongNumArgs): 
 	* generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make
 	Tcl_WrongNumArgs do replacement correctly with ensembles and other
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8be21cc..69ddffb 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.249 2007/06/10 23:15:05 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.250 2007/06/12 12:33:59 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -150,7 +150,6 @@ static const CmdInfo builtInCmds[] = {
     {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	1},
     {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	1},
     {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	1},
-    {"info",		Tcl_InfoObjCmd,		NULL,			1},
     {"join",		Tcl_JoinObjCmd,		NULL,			1},
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	1},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	1},
@@ -581,8 +580,9 @@ Tcl_CreateInterp(void)
     }
 
     /*
-     * Register clock and chan subcommands. These *do* go through
-     * Tcl_CreateObjCommand, since they aren't in the global namespace.
+     * Register "clock", "chan" and "info" subcommands. These *do* go through
+     * Tcl_CreateObjCommand, since they aren't in the global namespace and
+     * involve ensembles.
      */
 
     TclClockInit(interp);
@@ -594,6 +594,8 @@ Tcl_CreateInterp(void)
 		NULL, NULL);
     }
 
+    TclInitInfoCmd(interp);
+
     /* TIP #208 */
     Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
 	    TclChanTruncateObjCmd, NULL, NULL);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index cdda071..b7a26bf 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.115 2007/05/05 23:33:13 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.116 2007/06/12 12:34:00 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -153,6 +153,40 @@ static int		SortCompare(Tcl_Obj *firstPtr, Tcl_Obj *second,
 			    SortInfo *infoPtr);
 static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
 			    SortInfo *infoPtr);
+
+/*
+ * Array of values describing how to implement each standard subcommand of the
+ * "info" command.
+ */
+
+static const struct {
+    const char *name;		/* The name of the subcommand. */
+    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
+} defaultInfoMap[] = {
+    {"args",		InfoArgsCmd},
+    {"body",		InfoBodyCmd},
+    {"cmdcount",	InfoCmdCountCmd},
+    {"commands",	InfoCommandsCmd},
+    {"complete",	InfoCompleteCmd},
+    {"default",		InfoDefaultCmd},
+    {"exists",		InfoExistsCmd},
+    {"frame",		InfoFrameCmd},
+    {"functions",	InfoFunctionsCmd},
+    {"globals",		InfoGlobalsCmd},
+    {"hostname",	InfoHostnameCmd},
+    {"level",		InfoLevelCmd},
+    {"library",		InfoLibraryCmd},
+    {"loaded",		InfoLoadedCmd},
+    {"locals",		InfoLocalsCmd},
+    {"nameofexecutable",InfoNameOfExecutableCmd},
+    {"patchlevel",	InfoPatchLevelCmd},
+    {"procs",		InfoProcsCmd},
+    {"script",		InfoScriptCmd},
+    {"sharedlibextension", InfoSharedlibCmd},
+    {"tclversion",	InfoTclVersionCmd},
+    {"vars",		InfoVarsCmd},
+    {NULL, NULL}
+};
 
 /*
  *----------------------------------------------------------------------
@@ -345,124 +379,52 @@ Tcl_IncrObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_InfoObjCmd --
+ * TclInitInfoCmd --
  *
- *	This procedure is invoked to process the "info" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This function is called to create the "info" Tcl command. See the user
+ *	documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	FIXME
  *
  * Side effects:
- *	See the user documentation.
+ *	none
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_InfoObjCmd(
-    ClientData clientData,	/* Arbitrary value passed to the command. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+Tcl_Command
+TclInitInfoCmd(
+    Tcl_Interp *interp)		/* Current interpreter. */
 {
-    static CONST char *subCmds[] = {
-	"args", "body", "cmdcount", "commands",
-	"complete", "default", "exists", "frame", "functions",
-	"globals", "hostname", "level", "library", "loaded",
-	"locals", "nameofexecutable", "patchlevel", "procs",
-	"script", "sharedlibextension", "tclversion", "vars",
-	NULL};
-    enum ISubCmdIdx {
-	IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
-	ICompleteIdx, IDefaultIdx, IExistsIdx, IFrameIdx, IFunctionsIdx,
-	IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
-	ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
-	IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
-    };
-    int index, result;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
-	return TCL_ERROR;
-    }
-
-    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
-	    (int *) &index);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    switch (index) {
-    case IArgsIdx:
-	result = InfoArgsCmd(clientData, interp, objc, objv);
-	break;
-    case IBodyIdx:
-	result = InfoBodyCmd(clientData, interp, objc, objv);
-	break;
-    case ICmdCountIdx:
-	result = InfoCmdCountCmd(clientData, interp, objc, objv);
-	break;
-    case ICommandsIdx:
-	result = InfoCommandsCmd(clientData, interp, objc, objv);
-	break;
-    case ICompleteIdx:
-	result = InfoCompleteCmd(clientData, interp, objc, objv);
-	break;
-    case IDefaultIdx:
-	result = InfoDefaultCmd(clientData, interp, objc, objv);
-	break;
-    case IExistsIdx:
-	result = InfoExistsCmd(clientData, interp, objc, objv);
-	break;
-    case IFrameIdx:
-	/* TIP #280 - New method 'frame' */
-	result = InfoFrameCmd(clientData, interp, objc, objv);
-	break;
-    case IFunctionsIdx:
-	result = InfoFunctionsCmd(clientData, interp, objc, objv);
-	break;
-    case IGlobalsIdx:
-	result = InfoGlobalsCmd(clientData, interp, objc, objv);
-	break;
-    case IHostnameIdx:
-	result = InfoHostnameCmd(clientData, interp, objc, objv);
-	break;
-    case ILevelIdx:
-	result = InfoLevelCmd(clientData, interp, objc, objv);
-	break;
-    case ILibraryIdx:
-	result = InfoLibraryCmd(clientData, interp, objc, objv);
-	break;
-    case ILoadedIdx:
-	result = InfoLoadedCmd(clientData, interp, objc, objv);
-	break;
-    case ILocalsIdx:
-	result = InfoLocalsCmd(clientData, interp, objc, objv);
-	break;
-    case INameOfExecutableIdx:
-	result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);
-	break;
-    case IPatchLevelIdx:
-	result = InfoPatchLevelCmd(clientData, interp, objc, objv);
-	break;
-    case IProcsIdx:
-	result = InfoProcsCmd(clientData, interp, objc, objv);
-	break;
-    case IScriptIdx:
-	result = InfoScriptCmd(clientData, interp, objc, objv);
-	break;
-    case ISharedLibExtensionIdx:
-	result = InfoSharedlibCmd(clientData, interp, objc, objv);
-	break;
-    case ITclVersionIdx:
-	result = InfoTclVersionCmd(clientData, interp, objc, objv);
-	break;
-    case IVarsIdx:
-	result = InfoVarsCmd(clientData, interp, objc, objv);
-	break;
+    Tcl_Command ensemble;	/* The overall ensemble. */
+    Tcl_Namespace *tclNsPtr;	/* Reference to the "::tcl" namespace. */
+
+    tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN);
+    if (tclNsPtr == NULL) {
+	Tcl_Panic("unable to find or create ::tcl namespace!");
+    }
+    ensemble = Tcl_CreateEnsemble(interp, "::info", tclNsPtr,
+	    TCL_ENSEMBLE_PREFIX);
+    if (ensemble != NULL) {
+	Tcl_Obj *mapDict;
+	int i;
+
+	TclNewObj(mapDict);
+	for (i=0 ; defaultInfoMap[i].name != NULL ; i++) {
+	    Tcl_Obj *fromObj, *toObj;
+
+	    fromObj = Tcl_NewStringObj(defaultInfoMap[i].name, -1);
+	    TclNewLiteralStringObj(toObj, "::tcl::Info_");
+	    Tcl_AppendToObj(toObj, defaultInfoMap[i].name, -1);
+	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+	    Tcl_CreateObjCommand(interp, TclGetString(toObj),
+		    defaultInfoMap[i].proc, NULL, NULL);
+	}
+	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
     }
-    return result;
+    return ensemble;
 }
 
 /*
@@ -498,12 +460,12 @@ InfoArgsCmd(
     CompiledLocal *localPtr;
     Tcl_Obj *listObjPtr;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "procname");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname");
 	return TCL_ERROR;
     }
 
-    name = TclGetString(objv[2]);
+    name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
 	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
@@ -558,12 +520,12 @@ InfoBodyCmd(
     Proc *procPtr;
     Tcl_Obj *bodyPtr, *resultPtr;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "procname");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname");
 	return TCL_ERROR;
     }
 
-    name = TclGetString(objv[2]);
+    name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
 	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
@@ -624,8 +586,8 @@ InfoCmdCountCmd(
 {
     Interp *iPtr = (Interp *) interp;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -681,11 +643,11 @@ InfoCommandsCmd(
      * commands.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 3) {
+    } else if (objc == 2) {
 	/*
 	 * From the pattern, get the effective namespace and the simple
 	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
@@ -696,7 +658,7 @@ InfoCommandsCmd(
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
-	pattern = TclGetString(objv[2]);
+	pattern = TclGetString(objv[1]);
 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
 		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
@@ -704,7 +666,7 @@ InfoCommandsCmd(
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
@@ -941,13 +903,13 @@ InfoCompleteCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "command");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command");
 	return TCL_ERROR;
     }
 
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    TclObjCommandComplete(objv[2])));
+	    TclObjCommandComplete(objv[1])));
     return TCL_OK;
 }
 
@@ -984,13 +946,13 @@ InfoDefaultCmd(
     CompiledLocal *localPtr;
     Tcl_Obj *valueObjPtr;
 
-    if (objc != 5) {
-	Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
 	return TCL_ERROR;
     }
 
-    procName = TclGetString(objv[2]);
-    argName = TclGetString(objv[3]);
+    procName = TclGetString(objv[1]);
+    argName = TclGetString(objv[2]);
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
@@ -1003,7 +965,7 @@ InfoDefaultCmd(
 	if (TclIsVarArgument(localPtr)
 		&& (strcmp(argName, localPtr->name) == 0)) {
 	    if (localPtr->defValuePtr != NULL) {
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
 			localPtr->defValuePtr, 0);
 		if (valueObjPtr == NULL) {
 		    goto defStoreError;
@@ -1011,7 +973,7 @@ InfoDefaultCmd(
 		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
 	    } else {
 		Tcl_Obj *nullObjPtr = Tcl_NewObj();
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
 			nullObjPtr, 0);
 		if (valueObjPtr == NULL) {
 		    goto defStoreError;
@@ -1027,7 +989,7 @@ InfoDefaultCmd(
     return TCL_ERROR;
 
   defStoreError:
-    varName = TclGetString(objv[4]);
+    varName = TclGetString(objv[3]);
     Tcl_AppendResult(interp, "couldn't store default value in variable \"",
 	    varName, "\"", NULL);
     return TCL_ERROR;
@@ -1063,12 +1025,12 @@ InfoExistsCmd(
     char *varName;
     Var *varPtr;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "varName");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName");
 	return TCL_ERROR;
     }
 
-    varName = TclGetString(objv[2]);
+    varName = TclGetString(objv[1]);
     varPtr = TclVarTraceExists(interp, varName);
 
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
@@ -1119,7 +1081,7 @@ InfoFrameCmd(
     };
     Tcl_Obj *tmpObj;
 
-    if (objc == 2) {
+    if (objc == 1) {
 	/*
 	 * Just "info frame".
 	 */
@@ -1129,8 +1091,8 @@ InfoFrameCmd(
 
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), levels);
 	return TCL_OK;
-    } else if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    } else if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
 	return TCL_ERROR;
     }
 
@@ -1138,7 +1100,7 @@ InfoFrameCmd(
      * We've got "info frame level" and must parse the level first.
      */
 
-    if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+    if (Tcl_GetIntFromObj(interp, objv[1], &level) != TCL_OK) {
 	return TCL_ERROR;
     }
     if (level <= 0) {
@@ -1150,7 +1112,7 @@ InfoFrameCmd(
 	if (iPtr->cmdFramePtr == NULL) {
 	levelError:
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
-		    TclGetString(objv[2]), "\"", NULL);
+		    TclGetString(objv[1]), "\"", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -1375,12 +1337,12 @@ InfoFunctionsCmd(
 {
     char *pattern;
 
-    if (objc == 2) {
+    if (objc == 1) {
 	pattern = NULL;
-    } else if (objc == 3) {
-	pattern = TclGetString(objv[2]);
+    } else if (objc == 2) {
+	pattern = TclGetString(objv[1]);
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
@@ -1423,10 +1385,10 @@ InfoGlobalsCmd(
     Var *varPtr;
     Tcl_Obj *listPtr;
 
-    if (objc == 2) {
+    if (objc == 1) {
 	pattern = NULL;
-    } else if (objc == 3) {
-	pattern = TclGetString(objv[2]);
+    } else if (objc == 2) {
+	pattern = TclGetString(objv[1]);
 
 	/*
 	 * Strip leading global-namespace qualifiers. [Bug 1057461]
@@ -1438,7 +1400,7 @@ InfoGlobalsCmd(
 	    }
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
@@ -1505,8 +1467,8 @@ InfoHostnameCmd(
 {
     CONST char *name;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -1548,16 +1510,16 @@ InfoLevelCmd(
 {
     Interp *iPtr = (Interp *) interp;
 
-    if (objc == 2) {		/* Just "info level" */
+    if (objc == 1) {		/* Just "info level" */
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
 	return TCL_OK;
     }
 
-    if (objc == 3) {
+    if (objc == 2) {
 	int level;
 	CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
 
-	if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[1], &level) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (level <= 0) {
@@ -1581,11 +1543,11 @@ InfoLevelCmd(
 	return TCL_OK;
     }
 
-    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
     return TCL_ERROR;
 
   levelError:
-    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[2]), "\"",
+    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
 	    NULL);
     return TCL_ERROR;
 }
@@ -1620,8 +1582,8 @@ InfoLibraryCmd(
 {
     CONST char *libDirName;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -1665,15 +1627,15 @@ InfoLoadedCmd(
     char *interpName;
     int result;
 
-    if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?interp?");
+    if ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
 	return TCL_ERROR;
     }
 
-    if (objc == 2) {		/* Get loaded pkgs in all interpreters. */
+    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
 	interpName = NULL;
     } else {			/* Get pkgs just in specified interp. */
-	interpName = TclGetString(objv[2]);
+	interpName = TclGetString(objv[1]);
     }
     result = TclGetLoadedPackages(interp, interpName);
     return result;
@@ -1711,12 +1673,12 @@ InfoLocalsCmd(
     char *pattern;
     Tcl_Obj *listPtr;
 
-    if (objc == 2) {
+    if (objc == 1) {
 	pattern = NULL;
-    } else if (objc == 3) {
-	pattern = TclGetString(objv[2]);
+    } else if (objc == 2) {
+	pattern = TclGetString(objv[1]);
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
@@ -1863,8 +1825,8 @@ InfoNameOfExecutableCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
@@ -1901,8 +1863,8 @@ InfoPatchLevelCmd(
 {
     CONST char *patchlevel;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -1964,11 +1926,11 @@ InfoProcsCmd(
      * procs.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 3) {
+    } else if (objc == 2) {
 	/*
 	 * From the pattern, get the effective namespace and the simple
 	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
@@ -1979,7 +1941,7 @@ InfoProcsCmd(
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
-	pattern = TclGetString(objv[2]);
+	pattern = TclGetString(objv[1]);
 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
 		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
 		&simplePattern);
@@ -1988,7 +1950,7 @@ InfoProcsCmd(
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
@@ -2135,16 +2097,16 @@ InfoScriptCmd(
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
+    if ((objc != 1) && (objc != 2)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
 	return TCL_ERROR;
     }
 
-    if (objc == 3) {
+    if (objc == 2) {
 	if (iPtr->scriptFile != NULL) {
 	    Tcl_DecrRefCount(iPtr->scriptFile);
 	}
-	iPtr->scriptFile = objv[2];
+	iPtr->scriptFile = objv[1];
 	Tcl_IncrRefCount(iPtr->scriptFile);
     }
     if (iPtr->scriptFile != NULL) {
@@ -2181,8 +2143,8 @@ InfoSharedlibCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument objects. */
 {
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -2221,8 +2183,8 @@ InfoTclVersionCmd(
 {
     Tcl_Obj *version;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -2284,11 +2246,11 @@ InfoVarsCmd(
      * Tcl procedure frame.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 3) {
+    } else if (objc == 2) {
 	/*
 	 * From the pattern, get the effective namespace and the simple
 	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
@@ -2299,7 +2261,7 @@ InfoVarsCmd(
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
-	pattern = TclGetString(objv[2]);
+	pattern = TclGetString(objv[1]);
 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
 		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
 		&simplePattern);
@@ -2308,7 +2270,7 @@ InfoVarsCmd(
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8b015b0..64d81dd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.317 2007/06/12 12:29:05 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.318 2007/06/12 12:34:00 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -2611,9 +2611,7 @@ MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_IncrObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
-MODULE_SCOPE int	Tcl_InfoObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_InterpObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int argc,
 			    Tcl_Obj *CONST objv[]);
diff --git a/tests/info.test b/tests/info.test
index 527d217..94db6e7 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.44 2007/05/18 18:39:31 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.45 2007/06/12 12:34:04 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -43,13 +43,13 @@ test info-1.3 {info args option} {
     proc t1 "" {return foo}
     info args t1
 } {}
-test info-1.4 {info args option} {
+test info-1.4 {info args option} -body {
     catch {rename t1 {}}
-    list [catch {info args t1} msg] $msg
-} {1 {"t1" isn't a procedure}}
-test info-1.5 {info args option} {
-    list [catch {info args set} msg] $msg
-} {1 {"set" isn't a procedure}}
+    info args t1
+} -returnCodes error -result {"t1" isn't a procedure}
+test info-1.5 {info args option} -body {
+    info args set
+} -returnCodes error -result {"set" isn't a procedure}
 test info-1.6 {info args option} {
     proc t1 {a b} {set c 123; set d $c}
     t1 1 2
@@ -67,12 +67,12 @@ test info-2.1 {info body option} {
     proc t1 {} {body of t1}
     info body t1
 } {body of t1}
-test info-2.2 {info body option} {
-    list [catch {info body set} msg] $msg
-} {1 {"set" isn't a procedure}}
-test info-2.3 {info body option} {
-    list [catch {info args set 1} msg] $msg
-} {1 {wrong # args: should be "info args procname"}}
+test info-2.2 {info body option} -body {
+    info body set
+} -returnCodes error -result {"set" isn't a procedure}
+test info-2.3 {info body option} -body {
+    info args set 1
+} -returnCodes error -result {wrong # args: should be "info args procname"}
 test info-2.4 {info body option} {
     catch {namespace delete test_ns_info2}
     namespace eval test_ns_info2 {
@@ -112,17 +112,17 @@ proc testinfocmdcount {} {
 }
 test info-3.1 {info cmdcount compiled} {
     testinfocmdcount
-} 3
+} 4
 test info-3.2 {info cmdcount evaled} {
     set x [info cmdcount]
     set y 12345
     set z [info cm]
     expr $z-$x
-} 3
-test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
-test info-3.4 {info cmdcount option} {
-    list [catch {info cmdcount 1} msg] $msg
-} {1 {wrong # args: should be "info cmdcount"}}
+} 4
+test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 4
+test info-3.4 {info cmdcount option} -body {
+    info cmdcount 1
+} -returnCodes error -result {wrong # args: should be "info cmdcount"}
 
 test info-4.1 {info commands option} {
     proc t1 {} {}
@@ -149,14 +149,14 @@ test info-4.4 {info commands option} {
 } {_t1_ _t2_}
 catch {rename _t1_ {}}
 catch {rename _t2_ {}}
-test info-4.5 {info commands option} {
-    list [catch {info commands a b} msg] $msg
-} {1 {wrong # args: should be "info commands ?pattern?"}}
+test info-4.5 {info commands option} -returnCodes error -body {
+    info commands a b
+} -result {wrong # args: should be "info commands ?pattern?"}
 # Also some tests in namespace.test
 
-test info-5.1 {info complete option} {
-    list [catch {info complete} msg] $msg
-} {1 {wrong # args: should be "info complete command"}}
+test info-5.1 {info complete option} -body {
+    info complete
+} -returnCodes error -result {wrong # args: should be "info complete command"}
 test info-5.2 {info complete option} {
     info complete abc
 } 1
@@ -199,28 +199,30 @@ test info-6.5 {info default option} {
     set x [info default t1 e value]
     list $x $value
 } {1 {long default value}}
-test info-6.6 {info default option} {
-    list [catch {info default a b} msg] $msg
-} {1 {wrong # args: should be "info default procname arg varname"}}
-test info-6.7 {info default option} {
-    list [catch {info default _nonexistent_ a b} msg] $msg
-} {1 {"_nonexistent_" isn't a procedure}}
-test info-6.8 {info default option} {
+test info-6.6 {info default option} -returnCodes error -body {
+    info default a b
+} -result {wrong # args: should be "info default procname arg varname"}
+test info-6.7 {info default option} -returnCodes error -body {
+    info default _nonexistent_ a b
+} -result {"_nonexistent_" isn't a procedure}
+test info-6.8 {info default option} -returnCodes error -body {
     proc t1 {a b} {}
-    list [catch {info default t1 x value} msg] $msg
-} {1 {procedure "t1" doesn't have an argument "x"}}
-test info-6.9 {info default option} {
+    info default t1 x value
+} -result {procedure "t1" doesn't have an argument "x"}
+test info-6.9 {info default option} -returnCodes error -setup {
     catch {unset a}
+} -body {
     set a(0) 88
     proc t1 {a b} {}
-    list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
-test info-6.10 {info default option} {
+    info default t1 a a
+} -returnCodes error -result {couldn't store default value in variable "a"}
+test info-6.10 {info default option} -setup {
     catch {unset a}
+} -body {
     set a(0) 88
     proc t1 {{a 18} b} {}
-    list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
+    info default t1 a a
+} -returnCodes error -result {couldn't store default value in variable "a"}
 test info-6.11 {info default option} {
     catch {namespace delete test_ns_info2}
     namespace eval test_ns_info2 {
@@ -260,18 +262,19 @@ test info-7.6 {info exists option} {
     proc t1 {x} {return [info exists value]}
     t1 2
 } 0
-test info-7.7 {info exists option} {
+test info-7.7 {info exists option} -setup {
     catch {unset x}
+} -body {
     set x(2) 44
     list [info exists x] [info exists x(1)] [info exists x(2)]
-} {1 0 1}
+} -result {1 0 1}
 catch {unset x}
-test info-7.8 {info exists option} {
-    list [catch {info exists} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-test info-7.9 {info exists option} {
-    list [catch {info exists 1 2} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
+test info-7.8 {info exists option} -body {
+    info exists
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+test info-7.9 {info exists option} -body {
+    info exists 1 2
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
 
 test info-8.1 {info globals option} {
     set x 1
@@ -286,9 +289,9 @@ test info-8.2 {info globals option} {
     set _xxx2 2
     lsort [info g _xxx*]
 } {_xxx1 _xxx2}
-test info-8.3 {info globals option} {
-    list [catch {info globals 1 2} msg] $msg
-} {1 {wrong # args: should be "info globals ?pattern?"}}
+test info-8.3 {info globals option} -returnCodes error -body {
+    info globals 1 2
+} -result {wrong # args: should be "info globals ?pattern?"}
 test info-8.4 {info globals option: may have leading namespace qualifiers} {
     set x 0
     list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
@@ -336,23 +339,23 @@ test info-9.4 {info level option} {
     }
     t1
 } {1 t1}
-test info-9.5 {info level option} {
-    list [catch {info level 1 2} msg] $msg
-} {1 {wrong # args: should be "info level ?number?"}}
-test info-9.6 {info level option} {
-    list [catch {info level 123a} msg] $msg
-} {1 {expected integer but got "123a"}}
-test info-9.7 {info level option} {
-    list [catch {info level 0} msg] $msg
-} {1 {bad level "0"}}
-test info-9.8 {info level option} {
+test info-9.5 {info level option} -body {
+    info level 1 2
+} -returnCodes error -result {wrong # args: should be "info level ?number?"}
+test info-9.6 {info level option} -body {
+    info level 123a
+} -returnCodes error -result {expected integer but got "123a"}
+test info-9.7 {info level option} -body {
+    info level 0
+} -returnCodes error -result {bad level "0"}
+test info-9.8 {info level option} -body {
     proc t1 {} {info level -1}
-    list [catch {t1} msg] $msg
-} {1 {bad level "-1"}}
-test info-9.9 {info level option} {
+    t1
+} -returnCodes error -result {bad level "-1"}
+test info-9.9 {info level option} -body {
     proc t1 {x} {info level $x}
-    list [catch {t1 -3} msg] $msg
-} {1 {bad level "-3"}}
+    t1 -3
+} -returnCodes error -result {bad level "-3"}
 test info-9.10 {info level option, namespaces} {
     set msg [namespace eval t {info level 0}]
     namespace delete t
@@ -378,22 +381,22 @@ test info-9.12 {info level option, ensembles} -constraints knownBug -setup {
 } -result {a foo 1 2 3}
 
 set savedLibrary $tcl_library
-test info-10.1 {info library option} {
-    list [catch {info library x} msg] $msg
-} {1 {wrong # args: should be "info library"}}
+test info-10.1 {info library option} -body {
+    info library x
+} -returnCodes error -result {wrong # args: should be "info library"}
 test info-10.2 {info library option} {
     set tcl_library 12345
     info library
 } {12345}
-test info-10.3 {info library option} {
+test info-10.3 {info library option} -body {
     unset tcl_library
-    list [catch {info library} msg] $msg
-} {1 {no library has been specified for Tcl}}
+    info library
+} -returnCodes error -result {no library has been specified for Tcl}
 set tcl_library $savedLibrary
 
-test info-11.1 {info loaded option} {
-    list [catch {info loaded a b} msg] $msg
-} {1 {wrong # args: should be "info loaded ?interp?"}}
+test info-11.1 {info loaded option} -body {
+    info loaded a b
+} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
 test info-11.2 {info loaded option} {
     list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
 } {0 1 {could not find interpreter "gorp"}}
@@ -419,9 +422,9 @@ test info-12.2 {info locals option} {
     }
     lsort [t1 2 3]
 } {x xx1 xx2}
-test info-12.3 {info locals option} {
-    list [catch {info locals 1 2} msg] $msg
-} {1 {wrong # args: should be "info locals ?pattern?"}}
+test info-12.3 {info locals option} -body {
+    info locals 1 2
+} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
 test info-12.4 {info locals option} {
     info locals
 } {}
@@ -445,24 +448,25 @@ test info-12.7 {info locals with temporary variables} {
     t1
 } {a}
 
-test info-13.1 {info nameofexecutable option} {
-    list [catch {info nameofexecutable foo} msg] $msg
-} {1 {wrong # args: should be "info nameofexecutable"}}
+test info-13.1 {info nameofexecutable option} -returnCodes error -body {
+    info nameofexecutable foo
+} -result {wrong # args: should be "info nameofexecutable"}
 
 test info-14.1 {info patchlevel option} {
     set a [info patchlevel]
     regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
 } 1
-test info-14.2 {info patchlevel option} {
-    list [catch {info patchlevel a} msg] $msg
-} {1 {wrong # args: should be "info patchlevel"}}
-test info-14.3 {info patchlevel option} {
+test info-14.2 {info patchlevel option} -returnCodes error -body {
+    info patchlevel a
+} -result {wrong # args: should be "info patchlevel"}
+test info-14.3 {info patchlevel option} -setup {
     set t $tcl_patchLevel
+} -body {
     unset tcl_patchLevel
-    set result [list [catch {info patchlevel} msg] $msg]
+    info patchlevel
+} -cleanup {
     set tcl_patchLevel $t
-    set result
-} {1 {can't read "tcl_patchLevel": no such variable}}
+} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
 
 test info-15.1 {info procs option} {
     proc t1 {} {}
@@ -478,19 +482,21 @@ test info-15.2 {info procs option} {
 } {_tt1 _tt2}
 catch {rename _tt1 {}}
 catch {rename _tt2 {}}
-test info-15.3 {info procs option} {
-    list [catch {info procs 2 3} msg] $msg
-} {1 {wrong # args: should be "info procs ?pattern?"}}
-test info-15.4 {info procs option} {
+test info-15.3 {info procs option} -body {
+    info procs 2 3
+} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
+test info-15.4 {info procs option} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
         namespace import ::test_ns_info1::*
         proc r {} {}
         list [info procs] [info procs p*]
     }
-} {{p q r} p}
-test info-15.5 {info procs option with a proc in a namespace} {
+} -result {{p q r} p}
+test info-15.5 {info procs option with a proc in a namespace} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
 	proc p1 { arg } {
 	    puts cmd
@@ -500,9 +506,10 @@ test info-15.5 {info procs option with a proc in a namespace} {
 	}
     }
     info procs ::test_ns_info2::p1
-} {::test_ns_info2::p1}
-test info-15.6 {info procs option with a pattern in a namespace} {
+} -result {::test_ns_info2::p1}
+test info-15.6 {info procs option with a pattern in a namespace} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
 	proc p1 { arg } {
 	    puts cmd
@@ -512,9 +519,10 @@ test info-15.6 {info procs option with a pattern in a namespace} {
 	}
     }
     lsort [info procs ::test_ns_info2::p*]
-} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
-test info-15.7 {info procs option with a global shadowing proc} {
+} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
+test info-15.7 {info procs option with a global shadowing proc} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     proc string_cmd { arg } {
         puts cmd
     }
@@ -524,12 +532,13 @@ test info-15.7 {info procs option with a global shadowing proc} {
 	}
     }
     info procs test_ns_info2::string*
-} {::test_ns_info2::string_cmd}
+} -result {::test_ns_info2::string_cmd}
 # This regression test is currently commented out because it requires
 # that the implementation of "info procs" looks into the global namespace,
 # which it does not (in contrast to "info commands")
-test info-15.8 {info procs option with a global shadowing proc} knownBug {
+test info-15.8 {info procs option with a global shadowing proc} -setup {
     catch {namespace delete test_ns_info2}
+} -constraints knownBug -body {
     proc string_cmd { arg } {
         puts cmd
     }
@@ -544,11 +553,11 @@ test info-15.8 {info procs option with a global shadowing proc} knownBug {
     namespace eval test_ns_info2 {
         lsort [info procs string*]
     }
-} [lsort [list string_cmd string_cmd2]]
+} -result [lsort [list string_cmd string_cmd2]]
 
-test info-16.1 {info script option} {
-    list [catch {info script x x} msg] $msg
-} {1 {wrong # args: should be "info script ?filename?"}}
+test info-16.1 {info script option} -returnCodes error -body {
+    info script x x
+} -result {wrong # args: should be "info script ?filename?"}
 test info-16.2 {info script option} {
     file tail [info sc]
 } "info.test"
@@ -583,24 +592,24 @@ test info-16.8 {info script option} {
 } [list [list $gorpfile foo.bar] info.test]
 removeFile gorp.info
 
-test info-17.1 {info sharedlibextension option} {
-    list [catch {info sharedlibextension foo} msg] $msg
-} {1 {wrong # args: should be "info sharedlibextension"}}
+test info-17.1 {info sharedlibextension option} -returnCodes error -body {
+    info sharedlibextension foo
+} -result {wrong # args: should be "info sharedlibextension"}
 
 test info-18.1 {info tclversion option} {
-    set x [info tclversion]
-    scan $x "%d.%d%c" a b c
+    scan [info tclversion] "%d.%d%c" a b c
 } 2
-test info-18.2 {info tclversion option} {
-    list [catch {info t 2} msg] $msg
-} {1 {wrong # args: should be "info tclversion"}}
-test info-18.3 {info tclversion option} {
-    set t $tcl_version
+test info-18.2 {info tclversion option} -body {
+    info t 2
+} -returnCodes error -result {wrong # args: should be "info tclversion"}
+test info-18.3 {info tclversion option} -body {
     unset tcl_version
-    set result [list [catch {info tclversion} msg] $msg]
+    info tclversion
+} -returnCodes error -setup {
+    set t $tcl_version
+} -cleanup {
     set tcl_version $t
-    set result
-} {1 {can't read "tcl_version": no such variable}}
+} -result {can't read "tcl_version": no such variable}
 
 test info-19.1 {info vars option} {
     set a 1
@@ -625,9 +634,9 @@ test info-19.2 {info vars option} {
 test info-19.3 {info vars option} {
     lsort [info vars]
 } [lsort [info globals]]
-test info-19.4 {info vars option} {
-    list [catch {info vars a b} msg] $msg
-} {1 {wrong # args: should be "info vars ?pattern?"}}
+test info-19.4 {info vars option} -returnCodes error -body {
+    info vars a b
+} -result {wrong # args: should be "info vars ?pattern?"}
 test info-19.5 {info vars with temporary variables} {
     proc t1 {} {
         foreach a {b c} {}
@@ -657,25 +666,25 @@ test info-20.3 {info functions option} {
 test info-20.4 {info functions option} {
     lsort [info functions *tan*]
 } {atan atan2 tan tanh}
-test info-20.5 {info functions option} {
-    list [catch {info functions raise an error} msg] $msg
-} {1 {wrong # args: should be "info functions ?pattern?"}}
-
-test info-21.1 {miscellaneous error conditions} {
-    list [catch {info} msg] $msg
-} {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-21.2 {miscellaneous error conditions} {
-    list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.3 {miscellaneous error conditions} {
-    list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.4 {miscellaneous error conditions} {
-    list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.5 {miscellaneous error conditions} {
-    list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-20.5 {info functions option} -returnCodes error -body {
+    info functions raise an error
+} -result {wrong # args: should be "info functions ?pattern?"}
+
+test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
+    info
+} -result {wrong # args: should be "info subcommand ?argument ...?"}
+test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
+    info gorp
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
+    info c
+} -result {unknown or ambiguous subcommand "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
+    info l
+} -result {unknown or ambiguous subcommand "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
+    info s
+} -result {unknown or ambiguous subcommand "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 
 ##
 # ### ### ### ######### ######### #########
@@ -727,82 +736,69 @@ proc etrace {} {
 test info-22.0 {info frame, levels} {!singleTestInterp} {
     info frame
 } 7
-
 test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
     # catch is another level!, i.e. we have 8, not 7
     catch {info frame -8} msg
     set msg
 } {bad level "-8"}
-
 test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
     # catch is another level!, i.e. we have 8, not 7
     catch {info frame 9} msg
     set msg
 } {bad level "9"}
-
 test info-22.3 {info frame, current, relative} {
     info frame 0
 } {type eval line 2 cmd {info frame 0}}
-
 test info-22.4 {info frame, current, relative, nested} {
     set res [info frame 0]
 } {type eval line 2 cmd {info frame 0}}
-
 test info-22.5 {info frame, current, absolute} {!singleTestInterp} {
     reduce [info frame 7]
 } {type eval line 2 cmd {info frame 7}}
-
 test info-22.6 {info frame, global, relative} {!singleTestInterp} {
     reduce [info frame -6]
-} {type source line 755 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
-
+} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
 test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
     reduce [info frame 1]
-} {type source line 759 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
-
+} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
 test info-22.8 {info frame, basic trace} {!singleTestInterp} {
     join [etrace] \n
-} {8 {type source line 719 file info.test cmd {info frame $level} proc ::etrace level 0}
+} {8 {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
 7 {type eval line 2 cmd etrace}
 6 {type source line 2299 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
 5 {type eval line 1 cmd {::tcltest::RunTest info-22}}
 4 {type source line 1621 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ info-22}
 2 {type source line 1967 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
-1 {type source line 763 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trace\}\ \{!singleTestInter level 1}}
+1 {type source line 764 file info.test cmd test\ info-22.8\ \{info\ frame,\ basic\ trace\}\ \{!singleTestInter level 1}}
+
 ## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
 test info-23.0 {eval'd info frame} {!singleTestInterp} {
     eval {info frame}
 } 8
-
 test info-23.1 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
     eval info frame
 } 8
-
 test info-23.2 {eval'd info frame, dynamic} {!singleTestInterp} {
     set script {info frame}
     eval $script
 } 8
-
 test info-23.3 {eval'd info frame, literal} {
     eval {
 	info frame 0
     }
 } {type eval line 2 cmd {info frame 0}}
-
 test info-23.4 {eval'd info frame, semi-dynamic} {
     eval info frame 0
 } {type eval line 1 cmd {info frame 0}}
-
 test info-23.5 {eval'd info frame, dynamic} {
     set script {info frame 0}
     eval $script
 } {type eval line 1 cmd {info frame 0}}
-
 test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
     set script {etrace}
     join [eval $script] \n
-} {9 {type source line 719 file info.test cmd {info frame $level} proc ::etrace level 0}
+} {9 {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
 8 {type eval line 1 cmd etrace}
 7 {type eval line 3 cmd {eval $script}}
 6 {type source line 2299 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}
@@ -810,7 +806,7 @@ test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
 4 {type source line 1621 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::Eval}
 3 {type eval line 1 cmd ::tcltest::Eval\ \{::tcltest::RunTest\ info-23}
 2 {type source line 1967 file tcltest.tcl cmd {uplevel 1 [list [namespace origin Eval] $command 1]} proc ::tcltest::test}
-1 {type source line 802 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trace\}\ \{!singleTestInter level 1}}
+1 {type source line 798 file info.test cmd test\ info-23.6\ \{eval'd\ info\ frame,\ trace\}\ \{!singleTestInter level 1}}
 ## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
 # -------------------------------------------------------------------------
 
@@ -822,17 +818,19 @@ test info-23.6 {eval'd info frame, trace} {!singleTestInterp} {
 # causes the connection to the context to be lost. Currently only
 # procedure bodies are able to remember their context.
 
+# NOTE THAT THESE DO NOT USE THE -setup OPTION TO [test]
+
 # -------------------------------------------------------------------------
 
 namespace eval foo {
     proc bar {} {info frame 0}
 }
 
-test info-24.0 {info frame, interaction, namespace eval} {
+test info-24.0 {info frame, interaction, namespace eval} -body {
     reduce [foo::bar]
-} {type source line 828 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 826 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -842,11 +840,11 @@ if {$flag} {
     proc ::foo::bar {} {info frame 0}
 }
 
-test info-24.1 {info frame, interaction, if} {
+test info-24.1 {info frame, interaction, if} -body {
     reduce [foo::bar]
-} {type source line 842 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 840 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -857,11 +855,11 @@ while {$flag} {
     set flag 0
 }
 
-test info-24.2 {info frame, interaction, while} {
+test info-24.2 {info frame, interaction, while} -body {
     reduce [foo::bar]
-} {type source line 856 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 854 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -870,11 +868,11 @@ catch {
     proc ::foo::bar {} {info frame 0}
 }
 
-test info-24.3 {info frame, interaction, catch} {
+test info-24.3 {info frame, interaction, catch} -body {
     reduce [foo::bar]
-} {type source line 870 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 868 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -884,11 +882,11 @@ foreach var val {
     break
 }
 
-test info-24.4 {info frame, interaction, foreach} {
+test info-24.4 {info frame, interaction, foreach} -body {
     reduce [foo::bar]
-} {type source line 883 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 881 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -898,11 +896,11 @@ for {} {1} {} {
     break
 }
 
-test info-24.5 {info frame, interaction, for} {
+test info-24.5 {info frame, interaction, for} -body {
     reduce [foo::bar]
-} {type source line 897 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 895 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -912,12 +910,15 @@ eval {
 
 test info-25.0 {info frame, proc in eval} {
     reduce [bar]
-} {type source line 910 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 908 file info.test cmd {info frame 0} proc ::bar level 0}
+# Don't need to clean up yet...
 
 proc bar {} {info frame 0}
+
 test info-25.1 {info frame, regular proc} {
     reduce [bar]
-} {type source line 917 file info.test cmd {info frame 0} proc ::bar level 0}
+} {type source line 916 file info.test cmd {info frame 0} proc ::bar level 0}
+
 rename bar {}
 
 # -------------------------------------------------------------------------
@@ -993,12 +994,12 @@ switch -exact -- $x {
     }
 }
 
-test info-24.6.0 {info frame, interaction, switch, list body} {
+test info-24.6.0 {info frame, interaction, switch, list body} -body {
     reduce [foo::bar]
-} {type source line 992 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type source line 993 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1008,12 +1009,12 @@ switch -exact -- $x foo {
     proc ::foo::bar {} {info frame 0}
 }
 
-test info-24.6.1 {info frame, interaction, switch, multi-body} {
+test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
     reduce [foo::bar]
-} {type source line 1008 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type source line 1009 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1023,12 +1024,12 @@ switch -exact -- $x [list foo {
     proc ::foo::bar {} {info frame 0}
 }]
 
-test info-24.6.2 {info frame, interaction, switch, list body, dynamic} {
+test info-24.6.2 {info frame, interaction, switch, list body, dynamic} -body {
     reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1042,12 +1043,12 @@ namespace eval foo {}
 set x foo
 switch -exact -- $x $body
 
-test info-31.7 {info frame, interaction, switch, dynamic} {
+test info-31.7 {info frame, interaction, switch, dynamic} -body {
     reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
-unset x
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1058,11 +1059,11 @@ set body {
 namespace eval foo {}
 eval $body
 
-test info-32.0 {info frame, dynamic procedure} {
+test info-32.0 {info frame, dynamic procedure} -body {
     reduce [foo::bar]
-} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1071,11 +1072,11 @@ namespace {*}{
     foo
     {proc bar {} {info frame 0}}
 }
-test info-33.0 {{*}, literal, direct} {
+test info-33.0 {{*}, literal, direct} -body {
     reduce [foo::bar]
-} {type source line 1072 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1087,11 +1088,11 @@ proc foo::bar {} {
 	{info frame 0}
     }
 }
-test info-33.1 {{*}, literal, simple, bytecompiled} {
+test info-33.1 {{*}, literal, simple, bytecompiled} -body {
     reduce [foo::bar]
-} {type source line 1087 file info.test cmd {info frame 0} proc ::foo::bar level 0}
-
-namespace delete foo
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
 
@@ -1138,7 +1139,7 @@ proc foo {} {
 }
 test info-35.0 {apply, literal} {
     reduce [foo]
-} {type source line 1136 file info.test cmd {info frame 0} lambda {
+} {type source line 1137 file info.test cmd {info frame 0} lambda {
 	{x y}
 	{info frame 0}
     } level 0}
@@ -1165,7 +1166,7 @@ dict for {k v} {foo bar} {
 
 test info-24.7 {info frame, interaction, dict for} {
     reduce [foo::bar]
-} {type source line 1163 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1164 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
@@ -1179,7 +1180,7 @@ dict with thedict {
 
 test info-24.8 {info frame, interaction, dict with} {
     reduce [foo::bar]
-} {type source line 1177 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1178 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 unset thedict
@@ -1194,7 +1195,7 @@ dict filter {foo bar} script {k v} {
 
 test info-24.9 {info frame, interaction, dict filter} {
     reduce [foo::bar]
-} {type source line 1191 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1192 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 unset x
@@ -1210,7 +1211,7 @@ proc foo::bar {} {
 }
 test info-36.0 {info frame, dict for, bcc} {
     reduce [foo::bar]
-} {type source line 1207 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1208 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
@@ -1227,7 +1228,7 @@ proc foo::bar {} {
 
 test info-36.1.0 {switch, list literal, bcc} {
     reduce [foo::bar]
-} {type source line 1223 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1224 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
@@ -1242,7 +1243,7 @@ proc foo::bar {} {
 
 test info-36.1.1 {switch, multi-body literals, bcc} {
     reduce [foo::bar]
-} {type source line 1239 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1240 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
@@ -1255,7 +1256,7 @@ namespace {*}"
 "
 test info-33.2 {{*}, literal, direct} {
     reduce [foo::bar]
-} {type source line 1254 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1255 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
@@ -1281,7 +1282,7 @@ proc foo::bar {} {
 }
 test info-33.3 {{*}, literal, simple, bytecompiled} {
     reduce [foo::bar]
-} {type source line 1279 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+} {type source line 1280 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 namespace delete foo
 
diff --git a/tests/namespace.test b/tests/namespace.test
index f8433cc..3228d72 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.66 2007/03/12 19:10:50 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.67 2007/06/12 12:34:04 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -172,7 +172,10 @@ test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns}
 } {}
 test namespace-7.7 {Bug 1655305} -setup {
     interp create slave
-    slave hide info
+    # Can't invoke through the ensemble, since deleting the global namespace
+    # (indirectly, via deleting ::tcl) deletes the ensemble.
+    slave eval {rename ::tcl::Info_commands ::infocommands}
+    slave hide infocommands
     slave eval {
 	proc foo {} {
 	    namespace delete ::
@@ -180,7 +183,7 @@ test namespace-7.7 {Bug 1655305} -setup {
     }
 } -body {
     slave eval foo
-    slave invokehidden info commands
+    slave invokehidden infocommands
 } -cleanup {
     interp delete slave
 } -result {}
diff --git a/tests/trace.test b/tests/trace.test
index 5ab6a72..f549a4b 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: trace.test,v 1.51 2006/11/03 23:24:43 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.52 2007/06/12 12:34:04 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2249,7 +2249,7 @@ test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
 } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
 test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
     testcmdtrace tracetest {set stuff [info tclversion]}
-} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff [info tclversion]"]
+} [concat {{info tclversion} {info tclversion} ::tcl::Info_tclversion {::tcl::Info_tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
 test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
     testcmdtrace deletetest {set stuff [info tclversion]}
 } [info tclversion]
-- 
cgit v0.12