diff options
Diffstat (limited to 'generic/tclOO.c')
| -rw-r--r-- | generic/tclOO.c | 60 |
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 |