summaryrefslogtreecommitdiffstats
path: root/generic/tclOO.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r--generic/tclOO.c60
1 files changed, 38 insertions, 22 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 1ba0ba8..c1e8678 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOO.c,v 1.22 2009/05/08 08:48:19 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.23 2009/07/12 14:51:30 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -625,7 +625,7 @@ ObjectRenamedTrace(
AddRef(oPtr);
oPtr->flags |= OBJECT_DELETED;
- contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR);
+ contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
if (contextPtr != NULL) {
int result;
Tcl_InterpState state;
@@ -1330,7 +1330,8 @@ Tcl_NewObjectInstance(
*/
if (objc >= 0) {
- CallContext *contextPtr = TclOOGetCallContext(oPtr,NULL,CONSTRUCTOR);
+ CallContext *contextPtr =
+ TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr != NULL) {
int result;
@@ -1426,7 +1427,7 @@ TclNRNewObjectInstance(
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
}
- contextPtr = TclOOGetCallContext(oPtr,NULL,CONSTRUCTOR);
+ contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr == NULL) {
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
@@ -2097,34 +2098,49 @@ TclOOObjectCmdCore(
methodNamePtr = objv[1];
if (oPtr->mapMethodNameProc != NULL) {
register Class **startClsPtr = &startCls;
+ Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr);
- methodNamePtr = Tcl_DuplicateObj(methodNamePtr);
result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
- (Tcl_Class *) startClsPtr, methodNamePtr);
+ (Tcl_Class *) startClsPtr, mappedMethodName);
if (result != TCL_OK) {
- if (result == TCL_ERROR) {
+ Tcl_DecrRefCount(mappedMethodName);
+ if (result == TCL_BREAK) {
+ goto noMapping;
+ } else if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (while mapping method name)");
}
- Tcl_DecrRefCount(methodNamePtr);
return result;
}
- }
- Tcl_IncrRefCount(methodNamePtr);
- /*
- * Get the call chain.
- */
+ /*
+ * Get the call chain for the remapped name.
+ */
- contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
- flags | (oPtr->flags & FILTER_HANDLING));
- if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "impossible to invoke method \"",
- TclGetString(methodNamePtr),
- "\": no defined method or unknown method", NULL);
- Tcl_DecrRefCount(methodNamePtr);
- return TCL_ERROR;
+ Tcl_IncrRefCount(mappedMethodName);
+ contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
+ flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
+ Tcl_DecrRefCount(mappedMethodName);
+ if (contextPtr == NULL) {
+ Tcl_AppendResult(interp, "impossible to invoke method \"",
+ TclGetString(methodNamePtr),
+ "\": no defined method or unknown method", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Get the call chain.
+ */
+
+ noMapping:
+ 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);
+ return TCL_ERROR;
+ }
}
- Tcl_DecrRefCount(methodNamePtr);
/*
* Check to see if we need to apply magical tricks to start part way