Merged trunkcore-zipfs-consolidation

1 files changed, 133 insertions, 253 deletions

diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index f8b7ddd..914ed38 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -16,8 +16,6 @@
 #include "tclInt.h"
 #include "tclOOInt.h"
 
-static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void		SortPropList(Tcl_Obj *list);
 static Tcl_ObjCmdProc InfoObjectCallCmd;
 static Tcl_ObjCmdProc InfoObjectClassCmd;
 static Tcl_ObjCmdProc InfoObjectDefnCmd;
@@ -29,7 +27,6 @@ static Tcl_ObjCmdProc InfoObjectMethodsCmd;
 static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
 static Tcl_ObjCmdProc InfoObjectMixinsCmd;
 static Tcl_ObjCmdProc InfoObjectNsCmd;
-static Tcl_ObjCmdProc InfoObjectPropCmd;
 static Tcl_ObjCmdProc InfoObjectVarsCmd;
 static Tcl_ObjCmdProc InfoObjectVariablesCmd;
 static Tcl_ObjCmdProc InfoClassCallCmd;
@@ -43,7 +40,6 @@ static Tcl_ObjCmdProc InfoClassInstancesCmd;
 static Tcl_ObjCmdProc InfoClassMethodsCmd;
 static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
 static Tcl_ObjCmdProc InfoClassMixinsCmd;
-static Tcl_ObjCmdProc InfoClassPropCmd;
 static Tcl_ObjCmdProc InfoClassSubsCmd;
 static Tcl_ObjCmdProc InfoClassSupersCmd;
 static Tcl_ObjCmdProc InfoClassVariablesCmd;
@@ -64,7 +60,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
     {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
-    {"properties", InfoObjectPropCmd,	    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+    {"properties", TclOOInfoObjectPropCmd,  TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {NULL, NULL, NULL, NULL, NULL, 0}
@@ -86,7 +82,7 @@ static const EnsembleImplMap infoClassCmds[] = {
     {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-    {"properties",   InfoClassPropCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+    {"properties",   TclOOInfoClassPropCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
@@ -96,6 +92,23 @@ static const EnsembleImplMap infoClassCmds[] = {
 /*
  * ----------------------------------------------------------------------
  *
+ * LocalVarName --
+ *
+ *	Get the name of a local variable (especially a method argument) as a
+ *	Tcl value.
+ *
+ * ----------------------------------------------------------------------
+ */
+static inline Tcl_Obj *
+LocalVarName(
+    CompiledLocal *localPtr)
+{
+    return Tcl_NewStringObj(localPtr->name, TCL_AUTO_LENGTH);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOOInitInfo --
  *
  *	Adjusts the Tcl core [info] command to contain subcommands ("object"
@@ -134,7 +147,7 @@ TclOOInitInfo(
 /*
  * ----------------------------------------------------------------------
  *
- * GetClassFromObj --
+ * TclOOGetClassFromObj --
  *
  *	How to correctly get a class from a Tcl_Obj. Just a wrapper round
  *	Tcl_GetObjectFromObj, but this is an idiom that was used heavily.
@@ -142,8 +155,8 @@ TclOOInitInfo(
  * ----------------------------------------------------------------------
  */
 
-static inline Class *
-GetClassFromObj(
+Class *
+TclOOGetClassFromObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr)
 {
@@ -199,7 +212,7 @@ InfoObjectClassCmd(
 	Class *mixinPtr, *o2clsPtr;
 	Tcl_Size i;
 
-	o2clsPtr = GetClassFromObj(interp, objv[2]);
+	o2clsPtr = TclOOGetClassFromObj(interp, objv[2]);
 	if (o2clsPtr == NULL) {
 	    return TCL_ERROR;
 	}
@@ -257,22 +270,17 @@ InfoObjectDefnCmd(
     }
     hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]);
     if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"unknown method \"%s\"", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto unknownMethod;
     }
-    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
+    procPtr = TclOOGetProcFromMethod((Method *) Tcl_GetHashValue(hPtr));
     if (procPtr == NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"definition not available for this kind of method", -1));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto wrongType;
     }
 
+    /*
+     * We now have the method to describe the definition of.
+     */
+
     TclNewObj(resultObjs[0]);
     for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
 	    localPtr=localPtr->nextPtr) {
@@ -280,17 +288,34 @@ InfoObjectDefnCmd(
 	    Tcl_Obj *argObj;
 
 	    TclNewObj(argObj);
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
+	    Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
 	    if (localPtr->defValuePtr != NULL) {
 		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
 	    }
 	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
 	}
     }
-    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
+    resultObjs[1] = TclOOGetMethodBody((Method *) Tcl_GetHashValue(hPtr));
     Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
     return TCL_OK;
+
+    /*
+     * Errors...
+     */
+
+  unknownMethod:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "unknown method \"%s\"", TclGetString(objv[2])));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
+
+  wrongType:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "definition not available for this kind of method", -1));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -368,25 +393,38 @@ InfoObjectForwardCmd(
     }
     hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]);
     if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"unknown method \"%s\"", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto unknownMethod;
     }
-    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
+    prefixObj = TclOOGetFwdFromMethod((Method *) Tcl_GetHashValue(hPtr));
     if (prefixObj == NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"prefix argument list not available for this kind of method",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto wrongType;
     }
 
+    /*
+     * Describe the valid forward method.
+     */
+
     Tcl_SetObjResult(interp, prefixObj);
     return TCL_OK;
+
+    /*
+     * Errors...
+     */
+
+  unknownMethod:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "unknown method \"%s\"", TclGetString(objv[2])));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
+
+  wrongType:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "prefix argument list not available for this kind of method",
+	    -1));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -545,6 +583,10 @@ InfoObjectMethodsCmd(
 	SCOPE_LOCALPRIVATE
     };
 
+    /*
+     * Parse arguments.
+     */
+
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
 	return TCL_ERROR;
@@ -605,6 +647,10 @@ InfoObjectMethodsCmd(
 	}
     }
 
+    /*
+     * List matching methods.
+     */
+
     TclNewObj(resultObj);
     if (recurse) {
 	const char **names;
@@ -616,7 +662,7 @@ InfoObjectMethodsCmd(
 		    Tcl_NewStringObj(names[i], -1));
 	}
 	if (numNames > 0) {
-	    Tcl_Free((void *)names);
+	    Tcl_Free((void *) names);
 	}
     } else if (oPtr->methodsPtr) {
 	if (scope == -1) {
@@ -678,14 +724,9 @@ InfoObjectMethodTypeCmd(
     }
     hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]);
     if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"unknown method \"%s\"", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto unknownMethod;
     }
-    mPtr = (Method *)Tcl_GetHashValue(hPtr);
+    mPtr = (Method *) Tcl_GetHashValue(hPtr);
     if (mPtr->typePtr == NULL) {
 	/*
 	 * Special entry for visibility control: pretend the method doesnt
@@ -697,6 +738,13 @@ InfoObjectMethodTypeCmd(
 
     Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
     return TCL_OK;
+
+  unknownMethod:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "unknown method \"%s\"", TclGetString(objv[2])));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -835,6 +883,10 @@ InfoObjectVariablesCmd(
     }
     if (objc == 3) {
 	if (strcmp("-private", TclGetString(objv[2])) != 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "option \"%s\" is not exactly \"-private\"",
+		    TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_ARG");
 	    return TCL_ERROR;
 	}
 	isPrivate = 1;
@@ -949,7 +1001,7 @@ InfoClassConstrCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -971,8 +1023,7 @@ InfoClassConstrCmd(
 	    Tcl_Obj *argObj;
 
 	    TclNewObj(argObj);
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
+	    Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
 	    if (localPtr->defValuePtr != NULL) {
 		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
 	    }
@@ -1011,7 +1062,7 @@ InfoClassDefnCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1023,7 +1074,7 @@ InfoClassDefnCmd(
 		TclGetString(objv[2]), (char *)NULL);
 	return TCL_ERROR;
     }
-    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
+    procPtr = TclOOGetProcFromMethod((Method *) Tcl_GetHashValue(hPtr));
     if (procPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"definition not available for this kind of method", -1));
@@ -1039,15 +1090,14 @@ InfoClassDefnCmd(
 	    Tcl_Obj *argObj;
 
 	    TclNewObj(argObj);
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
+	    Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
 	    if (localPtr->defValuePtr != NULL) {
 		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
 	    }
 	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
 	}
     }
-    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
+    resultObjs[1] = TclOOGetMethodBody((Method *) Tcl_GetHashValue(hPtr));
     Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
     return TCL_OK;
 }
@@ -1082,7 +1132,7 @@ InfoClassDefnNsCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className ?kind?");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1126,7 +1176,7 @@ InfoClassDestrCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1171,7 +1221,7 @@ InfoClassFiltersCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1209,7 +1259,7 @@ InfoClassForwardCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1221,7 +1271,7 @@ InfoClassForwardCmd(
 		TclGetString(objv[2]), (char *)NULL);
 	return TCL_ERROR;
     }
-    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
+    prefixObj = TclOOGetFwdFromMethod((Method *) Tcl_GetHashValue(hPtr));
     if (prefixObj == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"prefix argument list not available for this kind of method",
@@ -1262,7 +1312,7 @@ InfoClassInstancesCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1321,7 +1371,7 @@ InfoClassMethodsCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1384,7 +1434,7 @@ InfoClassMethodsCmd(
 		    Tcl_NewStringObj(names[i], -1));
 	}
 	if (numNames > 0) {
-	    Tcl_Free((void *)names);
+	    Tcl_Free((void *) names);
 	}
     } else {
 	FOREACH_HASH_DECLS;
@@ -1437,21 +1487,16 @@ InfoClassMethodTypeCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
 
     hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]);
     if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"unknown method \"%s\"", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), (char *)NULL);
-	return TCL_ERROR;
+	goto unknownMethod;
     }
-    mPtr = (Method *)Tcl_GetHashValue(hPtr);
+    mPtr = (Method *) Tcl_GetHashValue(hPtr);
     if (mPtr->typePtr == NULL) {
 	/*
 	 * Special entry for visibility control: pretend the method doesnt
@@ -1462,6 +1507,13 @@ InfoClassMethodTypeCmd(
     }
     Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
     return TCL_OK;
+
+  unknownMethod:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "unknown method \"%s\"", TclGetString(objv[2])));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+	    TclGetString(objv[2]), (char *)NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -1489,7 +1541,7 @@ InfoClassMixinsCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1532,7 +1584,7 @@ InfoClassSubsCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1586,7 +1638,7 @@ InfoClassSupersCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1628,11 +1680,15 @@ InfoClassVariablesCmd(
     }
     if (objc == 3) {
 	if (strcmp("-private", TclGetString(objv[2])) != 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "option \"%s\" is not exactly \"-private\"",
+		    TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_ARG");
 	    return TCL_ERROR;
 	}
 	isPrivate = 1;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1693,6 +1749,7 @@ InfoObjectCallCmd(
     if (contextPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"cannot construct any call chain", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_CALL_CHAIN");
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp,
@@ -1725,7 +1782,7 @@ InfoClassCallCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
 	return TCL_ERROR;
     }
-    clsPtr = GetClassFromObj(interp, objv[1]);
+    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1738,6 +1795,7 @@ InfoClassCallCmd(
     if (callPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"cannot construct any call chain", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_CALL_CHAIN");
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
@@ -1746,184 +1804,6 @@ InfoClassCallCmd(
 }
 
 /*
- * ----------------------------------------------------------------------
- *
- * InfoClassPropCmd, InfoObjectPropCmd --
- *
- *	Implements [info class properties $clsName ?$option...?] and
- *	[info object properties $objName ?$option...?]
- *
- * ----------------------------------------------------------------------
- */
-
-enum PropOpt {
-    PROP_ALL, PROP_READABLE, PROP_WRITABLE
-};
-static const char *const propOptNames[] = {
-    "-all", "-readable", "-writable",
-    NULL
-};
-
-static int
-InfoClassPropCmd(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr;
-    int i, idx, all = 0, writable = 0, allocated = 0;
-    Tcl_Obj *result, *propObj;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    for (i = 2; i < objc; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
-		&idx) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (idx) {
-	case PROP_ALL:
-	    all = 1;
-	    break;
-	case PROP_READABLE:
-	    writable = 0;
-	    break;
-	case PROP_WRITABLE:
-	    writable = 1;
-	    break;
-	}
-    }
-
-    /*
-     * Get the properties.
-     */
-
-    if (all) {
-	result = TclOOGetAllClassProperties(clsPtr, writable, &allocated);
-	if (allocated) {
-	    SortPropList(result);
-	}
-    } else {
-	TclNewObj(result);
-	if (writable) {
-	    FOREACH(propObj, clsPtr->properties.writable) {
-		Tcl_ListObjAppendElement(NULL, result, propObj);
-	    }
-	} else {
-	    FOREACH(propObj, clsPtr->properties.readable) {
-		Tcl_ListObjAppendElement(NULL, result, propObj);
-	    }
-	}
-	SortPropList(result);
-    }
-    Tcl_SetObjResult(interp, result);
-    return TCL_OK;
-}
-
-static int
-InfoObjectPropCmd(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    int i, idx, all = 0, writable = 0, allocated = 0;
-    Tcl_Obj *result, *propObj;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    for (i = 2; i < objc; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
-		&idx) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (idx) {
-	case PROP_ALL:
-	    all = 1;
-	    break;
-	case PROP_READABLE:
-	    writable = 0;
-	    break;
-	case PROP_WRITABLE:
-	    writable = 1;
-	    break;
-	}
-    }
-
-    /*
-     * Get the properties.
-     */
-
-    if (all) {
-	result = TclOOGetAllObjectProperties(oPtr, writable, &allocated);
-	if (allocated) {
-	    SortPropList(result);
-	}
-    } else {
-	TclNewObj(result);
-	if (writable) {
-	    FOREACH(propObj, oPtr->properties.writable) {
-		Tcl_ListObjAppendElement(NULL, result, propObj);
-	    }
-	} else {
-	    FOREACH(propObj, oPtr->properties.readable) {
-		Tcl_ListObjAppendElement(NULL, result, propObj);
-	    }
-	}
-	SortPropList(result);
-    }
-    Tcl_SetObjResult(interp, result);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * SortPropList --
- *	Sort a list of names of properties. Simple support function. Assumes
- *	that the list Tcl_Obj is unshared and doesn't have a string
- *	representation.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-PropNameCompare(
-    const void *a,
-    const void *b)
-{
-    Tcl_Obj *first = *(Tcl_Obj **) a;
-    Tcl_Obj *second = *(Tcl_Obj **) b;
-
-    return strcmp(TclGetString(first), TclGetString(second));
-}
-
-static void
-SortPropList(
-    Tcl_Obj *list)
-{
-    Tcl_Size ec;
-    Tcl_Obj **ev;
-
-    Tcl_ListObjGetElements(NULL, list, &ec, &ev);
-    qsort(ev, ec, sizeof(Tcl_Obj *), PropNameCompare);
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4