merge trunk

1 files changed, 50 insertions, 30 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 47544f2..04a2bf7 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -81,6 +81,7 @@ static void		ObjectRenamedTrace(ClientData clientData,
 			    Tcl_Interp *interp, const char *oldName,
 			    const char *newName, int flags);
 static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
+static inline void	SquelchCachedName(Object *oPtr);
 static void		SquelchedNsFirst(ClientData clientData);
 
 static int		PublicObjectCmd(ClientData clientData,
@@ -704,6 +705,27 @@ AllocObject(
 /*
  * ----------------------------------------------------------------------
  *
+ * SquelchCachedName --
+ *
+ *	Encapsulates how to throw away a cached object name. Called from
+ *	object rename traces and at object destruction.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+SquelchCachedName(
+    Object *oPtr)
+{
+    if (oPtr->cachedNameObj) {
+	Tcl_DecrRefCount(oPtr->cachedNameObj);
+	oPtr->cachedNameObj = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * MyDeleted --
  *
  *	This callback is triggered when the object's [my] command is deleted
@@ -778,10 +800,7 @@ ObjectRenamedTrace(
      */
 
     if (flags & TCL_TRACE_RENAME) {
-	if (oPtr->cachedNameObj) {
-	    TclDecrRefCount(oPtr->cachedNameObj);
-	    oPtr->cachedNameObj = NULL;
-	}
+	SquelchCachedName(oPtr);
 	return;
     }
 
@@ -1138,10 +1157,7 @@ ObjectNamespaceDeleted(
 	TclOODeleteChainCache(oPtr->chainCache);
     }
 
-    if (oPtr->cachedNameObj) {
-	TclDecrRefCount(oPtr->cachedNameObj);
-	oPtr->cachedNameObj = NULL;
-    }
+    SquelchCachedName(oPtr);
 
     if (oPtr->metadataPtr != NULL) {
 	Tcl_ObjectMetadataType *metadataTypePtr;
@@ -1566,8 +1582,9 @@ Tcl_NewObjectInstance(
 
     if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
 	    TCL_NAMESPACE_ONLY)) {
-	Tcl_AppendResult(interp, "can't create object \"", nameStr,
-		"\": command already exists with that name", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create object \"%s\": command already exists with"
+		" that name", nameStr));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
 	return NULL;
     }
@@ -1633,8 +1650,8 @@ Tcl_NewObjectInstance(
 	     */
 
 	    if (result != TCL_ERROR && Deleted(oPtr)) {
-		Tcl_SetResult(interp, "object deleted in constructor",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"object deleted in constructor", -1));
 		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
 		result = TCL_ERROR;
 	    }
@@ -1689,8 +1706,9 @@ TclNRNewObjectInstance(
 
     if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
 	    TCL_NAMESPACE_ONLY)) {
-	Tcl_AppendResult(interp, "can't create object \"", nameStr,
-		"\": command already exists with that name", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create object \"%s\": command already exists with"
+		" that name", nameStr));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
 	return TCL_ERROR;
     }
@@ -1778,7 +1796,8 @@ FinalizeAlloc(
      */
 
     if (result != TCL_ERROR && Deleted(oPtr)) {
-	Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"object deleted in constructor", -1));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
 	result = TCL_ERROR;
     }
@@ -1835,7 +1854,8 @@ Tcl_CopyObjectInstance(
      */
 
     if (IsRootClass(oPtr)) {
-	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not clone the class of classes", -1));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
 	return NULL;
     }
@@ -2498,9 +2518,9 @@ TclOOObjectCmdCore(
 		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
 	TclDecrRefCount(mappedMethodName);
 	if (contextPtr == NULL) {
-	    Tcl_AppendResult(interp, "impossible to invoke method \"",
-		    TclGetString(methodNamePtr),
-		    "\": no defined method or unknown method", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "impossible to invoke method \"%s\": no defined method or"
+		    " unknown method", TclGetString(methodNamePtr)));
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
 		    TclGetString(methodNamePtr), NULL);
 	    return TCL_ERROR;
@@ -2514,9 +2534,9 @@ TclOOObjectCmdCore(
 	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
 		flags | (oPtr->flags & FILTER_HANDLING), NULL);
 	if (contextPtr == NULL) {
-	    Tcl_AppendResult(interp, "impossible to invoke method \"",
-		    TclGetString(methodNamePtr),
-		    "\": no defined method or unknown method", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "impossible to invoke method \"%s\": no defined method or"
+		    " unknown method", TclGetString(methodNamePtr)));
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
 		    TclGetString(methodNamePtr), NULL);
 	    return TCL_ERROR;
@@ -2542,8 +2562,8 @@ TclOOObjectCmdCore(
 	    }
 	}
 	if (contextPtr->index >= contextPtr->callPtr->numChain) {
-	    Tcl_SetResult(interp, "no valid method implementation",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "no valid method implementation", -1));
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
 		    TclGetString(methodNamePtr), NULL);
 	    TclOODeleteContext(contextPtr);
@@ -2624,8 +2644,8 @@ Tcl_ObjectContextInvokeNext(
 	    methodType = "method";
 	}
 
-	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
-		NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"no next %s implementation", methodType));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
 	return TCL_ERROR;
     }
@@ -2693,8 +2713,8 @@ TclNRObjectContextInvokeNext(
 	    methodType = "method";
 	}
 
-	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
-		NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"no next %s implementation", methodType));
 	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
 	return TCL_ERROR;
     }
@@ -2771,8 +2791,8 @@ Tcl_GetObjectFromObj(
     return cmdPtr->objClientData;
 
   notAnObject:
-    Tcl_AppendResult(interp, TclGetString(objPtr),
-	    " does not refer to an object", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "%s does not refer to an object", TclGetString(objPtr)));
     Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
 	    NULL);
     return NULL;