Index: TODO =================================================================== diff -u -r86057e0dc49bf59f550ed1b74e11a0e13198d0a8 -r7413d266916a491ff674489513351c89987366d7 --- TODO (.../TODO) (revision 86057e0dc49bf59f550ed1b74e11a0e13198d0a8) +++ TODO (.../TODO) (revision 7413d266916a491ff674489513351c89987366d7) @@ -3832,9 +3832,22 @@ - improve handling of multiple error messages in a single command +- alias reform: instead of calling first an alias with a stack frame + followed by the dispatched of the aliased cmd, resolve aliases + internally in dispatch. This has the advantage that we do not + have to ignore the "transparent" stack frame in some sitations, + and we have much less problems with the names of the aliased cmds + (e.g. objects) in the introspection methods. Additionally, several + problem cases disappeared from the regression test cases. + In addition, the new approach is faster. +- eliminating obsolete flag NSF_CSC_CALL_IS_TRANSPARENT + ======================================================================== TODO: +- make an additional attempt to use aliases instead of direct + object dispatches in ensembles - reconsider whether it is worth the effort. + - also aliasMethods pointing to objects require that these objects have allowmethoddispatch, since this is an object property (not an alias property). Index: generic/nsf.c =================================================================== diff -u -r86057e0dc49bf59f550ed1b74e11a0e13198d0a8 -r7413d266916a491ff674489513351c89987366d7 --- generic/nsf.c (.../nsf.c) (revision 86057e0dc49bf59f550ed1b74e11a0e13198d0a8) +++ generic/nsf.c (.../nsf.c) (revision 7413d266916a491ff674489513351c89987366d7) @@ -321,6 +321,8 @@ static int AliasDeleteObjectReference(Tcl_Interp *interp, Tcl_Command cmd); static int NsfMethodAliasCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, CONST char *methodName, int withFrame, Tcl_Obj *cmdName); +static int AliasRefetch(Tcl_Interp *interp, NsfObject *object, CONST char *methodName, + AliasCmdClientData *tcd); /* prototypes for (class) list handling */ static NsfClasses ** NsfClassListAdd(NsfClasses **firstPtrPtr, NsfClass *cl, ClientData clientData); @@ -9422,13 +9424,216 @@ return result; } +/* + *---------------------------------------------------------------------- + * ObjectCmdMethodDispatch -- + * + * Invoke a method implemented as ab object. The referenced object is used + * as a source for methods to be executed. Essentially this is currently + * primarily used to implement the dispatch of ensemble objects. + * + * Results: + * Tcl result code. + * + * Side effects: + * Indirect effects by calling cmd + * + *---------------------------------------------------------------------- + */ + +static int +ObjectCmdMethodDispatch(NsfObject *invokedObject, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], + CONST char *methodName, NsfObject *callerSelf, NsfCallStackContent *cscPtr) { + int result; + Tcl_Command cmd = cscPtr->cmdPtr; + + /*fprintf(stderr, "ObjectCmdMethodDispatch %p %s\n", cmd, Tcl_GetCommandName(interp, cmd));*/ + + assert(invokedObject); + + /*fprintf(stderr, "ObjectCmdMethodDispatch method %s invokedObject %p %s callerSelf %p %s\n", + methodName, invokedObject, ObjectName(invokedObject), + callerSelf, ObjectName(callerSelf));*/ + + if (unlikely(invokedObject->flags & NSF_DELETED)) { + /* + * When we try to invoke a deleted object, the cmd (alias) is + * automatically removed. Note that the cmd might be still referenced + * in various entries in the call-stack. The reference counting on + * these elements takes care that the cmdPtr is deleted on a pop + * operation (although we do a Tcl_DeleteCommandFromToken() below. + */ + + /*fprintf(stderr, "methodName %s found DELETED object with cmd %p my cscPtr %p\n", + methodName, cmd, cscPtr);*/ + + Tcl_DeleteCommandFromToken(interp, cmd); + if (cscPtr->cl) { + NsfInstanceMethodEpochIncr("DeleteObjectAlias"); + } else { + NsfObjectMethodEpochIncr("DeleteObjectAlias"); + } + + NsfCleanupObject(invokedObject, "alias-delete1"); + return NsfPrintError(interp, "Trying to dispatch deleted object via method '%s'", + methodName); + } + + /* + * Make sure, that the current call is marked as an ensemble call, both + * for dispatching to the default-method and for dispatching the method + * interface of the given object. Otherwise, current introspection + * specific to sub-methods fails (e.g., a [current method-path] in the + * default-method). + */ + cscPtr->flags |= NSF_CSC_CALL_IS_ENSEMBLE; + + /* fprintf(stderr, "ensemble dispatch cp %s %s objc %d\n", + ObjectName((NsfObject*)cp), methodName, objc);*/ + + /* + * Check, if the object cmd was called without a reference to a method. If + * so, perform the standard dispatch of default methods. + */ + + if (unlikely(objc < 2)) { + CallFrame frame, *framePtr = &frame; + Nsf_PushFrameCsc(interp, cscPtr, framePtr); + result = DispatchDefaultMethod(interp, invokedObject, objv[0], NSF_CSC_IMMEDIATE); + Nsf_PopFrameCsc(interp, framePtr); + } else { + CallFrame frame, *framePtr = &frame; + char *subMethodName = ObjStr(objv[1]); + + cscPtr->objc = objc; + cscPtr->objv = objv; + Nsf_PushFrameCsc(interp, cscPtr, framePtr); + + if (likely(invokedObject->nsPtr != NULL)) { + cmd = FindMethod(invokedObject->nsPtr, subMethodName); + + /*fprintf(stderr, "... objv[0] %s cmd %p %s csc %p\n", + ObjStr(objv[0]), cmd, subMethodName, cscPtr); */ + + if (likely(cmd != NULL)) { + /* + * In order to allow [next] to be called in an ensemble method, + * an extra call-frame is needed. This CSC frame is typed as + * NSF_CSC_TYPE_ENSEMBLE. Note that the associated call is flagged + * additionally (NSF_CSC_CALL_IS_ENSEMBLE; see above) to be able + * to identify ensemble-specific frames during [next] execution. + * + * The dispatch requires NSF_CSC_IMMEDIATE to be set, ensuring + * that scripted methods are executed before the ensemble ends. If + * they were executed later, they would find their parent frame + * (CMETHOD) being popped from the stack already. + */ + NsfObject *newSelf; + NsfClass *newClass; + + if (invokedObject->flags & NSF_KEEP_CALLER_SELF) { + newSelf = callerSelf; + newClass = cscPtr->cl; + } else { + newSelf = invokedObject; + newClass = NULL; + } + /*fprintf(stderr, ".... ensemble dispatch object %s self %s pass %s\n", + ObjectName(object), ObjectName(self), (self->flags & NSF_KEEP_CALLER_SELF) ? "callerSelf" : "invokedObject"); + fprintf(stderr, ".... ensemble dispatch on %s.%s objflags %.8x cscPtr %p base flags %.6x flags %.6x cl %s\n", + ObjectName(newSelf), subMethodName, self->flags, + cscPtr, (0xFF & cscPtr->flags), (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE, + newClass ? ClassName(newClass) : "NONE");*/ + result = MethodDispatch(newSelf, + interp, objc-1, objv+1, + cmd, newSelf, newClass, subMethodName, + cscPtr->frameType|NSF_CSC_TYPE_ENSEMBLE, + (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE); + /*if (result != TCL_OK) { + fprintf(stderr, "ERROR: cmd %p %s subMethodName %s // %s // %s\n", + cmd, Tcl_GetCommandName(interp, cmd), subMethodName, + Tcl_GetCommandName(interp, cscPtr->cmdPtr), ObjStr(Tcl_GetObjResult(interp))); + }*/ + goto obj_dispatch_ok; + } + } + + /* + * The method to be called was not part of this ensemble. Call + * next to try to call such methods along the next path. + */ + /*fprintf(stderr, "call next instead of unknown %s.%s \n", + ObjectName(cscPtr->self), methodName);*/ + { + Tcl_CallFrame *framePtr1; + NsfCallStackContent *cscPtr1 = CallStackGetTopFrame(interp, &framePtr1); + + assert(cscPtr1); + if ((cscPtr1->frameType & NSF_CSC_TYPE_ENSEMBLE)) { + /* + * We are in an ensemble method. The next works here not on the + * actual methodName + frame, but on the ensemble above it. We + * locate the appropriate call-stack content and continue next on + * that. + */ + cscPtr1 = CallStackFindEnsembleCsc(framePtr1, &framePtr1); + assert(cscPtr1); + } + + /* + * The method name for next might be colon-prefixed. In + * these cases, we have to skip the single colon. + */ + result = NextSearchAndInvoke(interp, MethodName(cscPtr1->objv[0]), + cscPtr1->objc, cscPtr1->objv, cscPtr1, 0); + } + + /*fprintf(stderr, "==> next %s.%s (obj %s) csc %p returned %d unknown %d\n", + ObjectName(self), methodName, ObjectName(object), cscPtr, result, + RUNTIME_STATE(interp)->unknown); */ + + if (RUNTIME_STATE(interp)->unknown) { + /* + * Unknown handling: We trigger a dispatch to an unknown method. The + * appropriate unknown handler is either provided for the current + * object (at the class or the mixin level), or the default unknown + * handler takes it from there. The application-level unknown + * handler cannot determine the top-level calling object (referred + * to as the delegator). Therefore, we assemble all the necessary + * call data as the first argument passed to the unknown + * handler. Call data include the calling object (delegator), the + * method path, and the unknown final method. + */ + Tcl_Obj *callInfoObj = Tcl_NewListObj(1, &callerSelf->cmdName); + Tcl_Obj *methodPathObj = CallStackMethodPath(interp, (Tcl_CallFrame *)framePtr); + + INCR_REF_COUNT(methodPathObj); + Tcl_ListObjAppendList(interp, callInfoObj, methodPathObj); + + Tcl_ListObjAppendElement(interp, callInfoObj, Tcl_NewStringObj(MethodName(objv[0]), -1)); + Tcl_ListObjAppendElement(interp, callInfoObj, objv[1]); + + DECR_REF_COUNT(methodPathObj); + + result = DispatchUnknownMethod(interp, invokedObject, objc-1, objv+1, callInfoObj, + objv[1], NSF_CM_NO_OBJECT_METHOD|NSF_CSC_IMMEDIATE); + } + + obj_dispatch_ok: + Nsf_PopFrameCsc(interp, framePtr); + + } + return result; +} + #if !defined(NSF_ASSEMBLE) static int NsfAsmProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { return TCL_OK; } #endif + /* *---------------------------------------------------------------------- * MethodDispatchCsc -- @@ -9454,15 +9659,61 @@ NsfObject *object = cscPtr->self; ClientData cp = Tcl_Command_objClientData(cmd); Tcl_ObjCmdProc *proc = Tcl_Command_objProc(cmd); + NsfCallStackContent *cscPtr1; int result; + /* + * In a first step, resolve the alias + */ + + if (proc == NsfProcAliasMethod) { + AliasCmdClientData *tcd = (AliasCmdClientData *)cp; + + assert(tcd); + assert((CmdIsProc(cmd) == 0)); + + /*fprintf(stderr, "NsfProcAliasMethod aliasedCmd %p epoch %p\n", + tcd->aliasedCmd, Tcl_Command_cmdEpoch(tcd->aliasedCmd));*/ + + if (Tcl_Command_cmdEpoch(tcd->aliasedCmd)) { + + result = AliasRefetch(interp, object, methodName, tcd); + if (result != TCL_OK) { + // TODO: check freeing of csc? + return result; + } + } + + /* + * We have now the original command still in cscPtr->cmdPtr and the + * aliasedCmd in tcd. + * + tcd->cmdName = object->cmdName; + tcd->interp = interp; // just for deleting the alias + tcd->object = NULL; + tcd->class = cl ? (NsfClass *) object : NULL; + tcd->objProc = objProc; + tcd->aliasedCmd = cmd; + tcd->clientData = Tcl_Command_objClientData(cmd); + */ + + cmd = tcd->aliasedCmd; + proc = Tcl_Command_objProc(cmd); + cp = Tcl_Command_objClientData(cmd); + + // TODO: dereference chain? + } + if (NSF_DTRACE_METHOD_ENTRY_ENABLED()) { NSF_DTRACE_METHOD_ENTRY(ObjectName(object), cscPtr->cl ? ClassName(cscPtr->cl) : ObjectName(object), (char *)methodName, objc-1, (Tcl_Obj **)objv+1); } + /*fprintf(stderr, "MethodDispatch method '%s' cmd %p %s clientData %p cp=%p objc=%d cscPtr %p csc->flags %.6x \n", + methodName, cmd, Tcl_GetCommandName(interp, cmd), clientData, + cp, objc, cscPtr, cscPtr->flags);*/ /*fprintf(stderr, "MethodDispatch method '%s' cmd %p cp=%p objc=%d cscPtr %p csc->flags %.6x " "obj->flags %.6x teardown %p\n", methodName, cmd, cp, objc, cscPtr, cscPtr->flags, object->flags, object->teardown);*/ @@ -9511,228 +9762,88 @@ */ return result; - } else if (cp - || (Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) - || (cscPtr->flags & NSF_CSC_FORCE_FRAME)) { - /* - * The cmd has client data or we force the frame either via - * cmd-flag or csc-flag - */ - if (CmdIsNsfObject(cmd)) { - /* - * Invoke an may be aliased object (ensemble object) via method - * interface. - */ - NsfObject *invokeObj = (NsfObject *)cp; + } else if (proc == NsfObjDispatch) { - assert(invokeObj); - if (unlikely(invokeObj->flags & NSF_DELETED)) { - /* - * When we try to invoke a deleted object, the cmd (alias) is - * automatically removed. Note that the cmd might be still referenced - * in various entries in the call-stack. The reference counting on - * these elements takes care that the cmdPtr is deleted on a pop - * operation (although we do a Tcl_DeleteCommandFromToken() below. - */ + assert(cp); + return ObjectCmdMethodDispatch((NsfObject *)cp, interp, objc, objv, + methodName, object, cscPtr); + + } else if (cp) { - /*fprintf(stderr, "methodName %s found DELETED object with cmd %p my cscPtr %p\n", - methodName, cmd, cscPtr);*/ - - assert(cscPtr->cmdPtr == cmd); - Tcl_DeleteCommandFromToken(interp, cmd); - if (cscPtr->cl) { - NsfInstanceMethodEpochIncr("DeleteObjectAlias"); - } else { - NsfObjectMethodEpochIncr("DeleteObjectAlias"); - } - - NsfCleanupObject(invokeObj, "alias-delete1"); - return NsfPrintError(interp, "Trying to dispatch deleted object via method '%s'", - methodName); - } - - /* - * Make sure, that the current call is marked as an ensemble call, both - * for dispatching to the default-method and for dispatching the method - * interface of the given object. Otherwise, current introspection - * specific to sub-methods fails (e.g., a [current method-path] in the - * default-method). - */ - cscPtr->flags |= NSF_CSC_CALL_IS_ENSEMBLE; - - /* - * The client data cp is still the obj (the ensemble object) of the called method - */ - - /*fprintf(stderr, "ensemble dispatch cp %s %s objc %d\n", - ObjectName((NsfObject*)cp), methodName, objc);*/ - - if (unlikely(objc < 2)) { - CallFrame frame, *framePtr = &frame; - Nsf_PushFrameCsc(interp, cscPtr, framePtr); - result = DispatchDefaultMethod(interp, invokeObj, objv[0], NSF_CSC_IMMEDIATE); - Nsf_PopFrameCsc(interp, framePtr); - } else { - CallFrame frame, *framePtr = &frame; - NsfObject *self = (NsfObject *)cp; - char *methodName = ObjStr(objv[1]); - - cscPtr->objc = objc; - cscPtr->objv = objv; - Nsf_PushFrameCsc(interp, cscPtr, framePtr); - - if (likely(self->nsPtr != NULL)) { - cmd = FindMethod(self->nsPtr, methodName); - - /*fprintf(stderr, "... objv[0] %s cmd %p %s csc %p\n", - ObjStr(objv[0]), cmd, methodName, cscPtr); */ - - if (likely(cmd != NULL)) { - /* - * In order to allow [next] to be called in an ensemble method, - * an extra call-frame is needed. This CSC frame is typed as - * NSF_CSC_TYPE_ENSEMBLE. Note that the associated call is flagged - * additionally (NSF_CSC_CALL_IS_ENSEMBLE; see above) to be able - * to identify ensemble-specific frames during [next] execution. - * - * The dispatch requires NSF_CSC_IMMEDIATE to be set, ensuring - * that scripted methods are executed before the ensemble ends. If - * they were executed later, they would find their parent frame - * (CMETHOD) being popped from the stack already. - */ - // FIXME: decls should not stay here, can / should we reuse other vars? - NsfObject *newSelf; - NsfClass *newClass; - if (self->flags & NSF_KEEP_CALLER_SELF) { - newSelf = object; - newClass = cscPtr->cl; - } else { - newSelf = self; - newClass = NULL; - } - /*fprintf(stderr, ".... ensemble dispatch object %s self %s pass %s\n", - ObjectName(object), ObjectName(self), (self->flags & NSF_KEEP_CALLER_SELF) ? "object" : "self");*/ - /*fprintf(stderr, ".... ensemble dispatch on %s.%s objflags %.8x cscPtr %p base flags %.6x cl %s\n", - ObjectName(newSelf), methodName, self->flags, - cscPtr, (0xFF & cscPtr->flags), - newClass ? ClassName(newClass) : "NONE");*/ - result = MethodDispatch(newSelf, - interp, objc-1, objv+1, - cmd, newSelf, newClass, methodName, - cscPtr->frameType|NSF_CSC_TYPE_ENSEMBLE, - (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE); - goto obj_dispatch_ok; - } - } - - /* - * The method to be called was not part of this ensemble. Call - * next to try to call such methods along the next path. - */ - /*fprintf(stderr, "call next instead of unknown %s.%s \n", - ObjectName(cscPtr->self), methodName);*/ - { - Tcl_CallFrame *framePtr1; - NsfCallStackContent *cscPtr1 = CallStackGetTopFrame(interp, &framePtr1); - - assert(cscPtr1); - if ((cscPtr1->frameType & NSF_CSC_TYPE_ENSEMBLE)) { - /* - * We are in an ensemble method. The next works here not on the - * actual methodName + frame, but on the ensemble above it. We - * locate the appropriate call-stack content and continue next on - * that. - */ - cscPtr1 = CallStackFindEnsembleCsc(framePtr1, &framePtr1); - assert(cscPtr1); - } - - /* - * The method name for next might be colon-prefixed. In - * these cases, we have to skip the single colon. - */ - result = NextSearchAndInvoke(interp, MethodName(cscPtr1->objv[0]), - cscPtr1->objc, cscPtr1->objv, cscPtr1, 0); - } - - /*fprintf(stderr, "==> next %s.%s (obj %s) csc %p returned %d unknown %d\n", - ObjectName(self), methodName, ObjectName(object), cscPtr, result, - RUNTIME_STATE(interp)->unknown); */ - - if (RUNTIME_STATE(interp)->unknown) { - /* - * Unknown handling: We trigger a dispatch to an unknown method. The - * appropriate unknown handler is either provided for the current - * object (at the class or the mixin level), or the default unknown - * handler takes it from there. The application-level unknown - * handler cannot determine the top-level calling object (referred - * to as the delegator). Therefore, we assemble all the necessary - * call data as the first argument passed to the unknown - * handler. Call data include the calling object (delegator), the - * method path, and the unknown final method. - */ - Tcl_Obj *callInfoObj = Tcl_NewListObj(1, &object->cmdName); - Tcl_Obj *methodPathObj = CallStackMethodPath(interp, (Tcl_CallFrame *)framePtr); - - INCR_REF_COUNT(methodPathObj); - Tcl_ListObjAppendList(interp, callInfoObj, methodPathObj); - - Tcl_ListObjAppendElement(interp, callInfoObj, Tcl_NewStringObj(MethodName(objv[0]), -1)); - Tcl_ListObjAppendElement(interp, callInfoObj, objv[1]); - - DECR_REF_COUNT(methodPathObj); - - result = DispatchUnknownMethod(interp, self, objc-1, objv+1, callInfoObj, - objv[1], NSF_CM_NO_OBJECT_METHOD|NSF_CSC_IMMEDIATE); - } - obj_dispatch_ok: - Nsf_PopFrameCsc(interp, framePtr); - - } - return result; - - } else if (proc == NsfForwardMethod || - proc == NsfObjscopedMethod || - proc == NsfSetterMethod || - proc == NsfAsmProc - ) { + cscPtr1 = cscPtr; + + /*fprintf(stderr, "cscPtr %p cmd %p %s wanna stack cmd %p %s cp %p no-leaf %d force frame %d\n", + cscPtr, cmd, Tcl_GetCommandName(interp, cmd), + cmd, Tcl_GetCommandName(interp, cmd), + cp, + (Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD), + (cscPtr->flags & NSF_CSC_FORCE_FRAME));*/ + /* + * The cmd has client data, we check for required updates in this + * structure. + */ + + if (proc == NsfForwardMethod || + proc == NsfObjscopedMethod || + proc == NsfSetterMethod || + proc == NsfAsmProc + ) { TclCmdClientData *tcd = (TclCmdClientData *)cp; assert(tcd); tcd->object = object; assert((CmdIsProc(cmd) == 0)); - } else if (proc == NsfProcAliasMethod) { - TclCmdClientData *tcd = (TclCmdClientData *)cp; - assert(tcd); - tcd->object = object; - assert((CmdIsProc(cmd) == 0)); - cscPtr->flags |= NSF_CSC_CALL_IS_TRANSPARENT; - } else if (cp == (ClientData)NSF_CMD_NONLEAF_METHOD) { cp = clientData; assert((CmdIsProc(cmd) == 0)); - } + } +#if !defined(NDEBUG) + else if (proc == NsfProcAliasMethod) { + /* This should never happen */ + assert(0); + } +#endif + + + } else if ((Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) + || (cscPtr->flags & NSF_CSC_FORCE_FRAME)) { + /* + * Technically, we would not need a frame to execute the cmd, but maybe, + * the user want's it (to be able to call next, or the keep proc-level + * variables. The clientData cp is in such cases typically NULL. + */ + /*fprintf(stderr, "FORCE_FRAME\n");*/ + cscPtr1 = cscPtr; + } else { /* - * The cmd has no client data. In these situations, no stack frame - * is needed. Dispatch the method without the cscPtr, such - * CmdMethodDispatch() does not stack a frame. + * There is no need to pass a frame. Use the original clientData. */ + cscPtr1 = NULL; + } + + if (cscPtr1) { + /* + * Call with a stack frame. + */ + /*fprintf(stderr, "cmdMethodDispatch %s.%s, cscPtr %p objflags %.6x\n", + ObjectName(object), methodName, cscPtr, object->flags); */ + + return CmdMethodDispatch(cp, interp, objc, objv, object, cmd, cscPtr1); + } else { + /* + * Call without a stack frame. + */ CscListAdd(interp, cscPtr); /*fprintf(stderr, "cmdMethodDispatch %p %s.%s, nothing stacked, objflags %.6x\n", cmd, ObjectName(object), methodName, object->flags); */ - + return CmdMethodDispatch(clientData, interp, objc, objv, object, cmd, NULL); } - - /*fprintf(stderr, "cmdMethodDispatch %s.%s, cscPtr %p objflags %.6x\n", - ObjectName(object), methodName, cscPtr, object->flags); */ - - return CmdMethodDispatch(cp, interp, objc, objv, object, cmd, cscPtr); } /* @@ -15612,14 +15723,15 @@ *---------------------------------------------------------------------- * NsfProcAliasMethod -- * - * This Tcl_ObjCmdProc is called, when an alias to a proc is invoked. It - * handled epoched procs and dispatches finally the target method. + * Since alias-resolving happens in dispatch, this Tcl_ObjCmdProc should + * never be called during normal operations. The only way to invoke this + * could happen via directly calling the handle. * * Results: - * Tcl result code. + * TCL_ERROR * * Side effects: - * Maybe through the invoked command. + * None. * *---------------------------------------------------------------------- */ @@ -15629,86 +15741,10 @@ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { AliasCmdClientData *tcd = (AliasCmdClientData *)clientData; - CONST char *methodName = ObjStr(objv[0]); - NsfObject *self; assert(tcd); - self = tcd->object; - - if (!self) { - return NsfDispatchClientDataError(interp, self, "object", - Tcl_GetCommandName(interp, tcd->aliasCmd)); - } - tcd->object = NULL; - - assert(self == GetSelfObj(interp)); - - /*fprintf(stderr, "NsfProcAliasMethod aliasedCmd %p epoch %p\n", - tcd->aliasedCmd, Tcl_Command_cmdEpoch(tcd->aliasedCmd));*/ - - if (Tcl_Command_cmdEpoch(tcd->aliasedCmd)) { - NsfObject *defObject = tcd->class ? &(tcd->class->object) : self; - Tcl_Obj **listElements, *entryObj, *targetObj; - int nrElements, withPer_object; - Tcl_Command cmd; - - /* - * Get the targetObject. Currently, we can get it just via the - * alias array. - */ - withPer_object = tcd->class ? 0 : 1; - entryObj = AliasGet(interp, defObject->cmdName, methodName, withPer_object, 1); - if (entryObj == NULL) { - return TCL_ERROR; - } - INCR_REF_COUNT(entryObj); - - Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements); - targetObj = listElements[nrElements-1]; - - NsfLog(interp, NSF_LOG_NOTICE, - "trying to dispatch an epoched cmd %p as %s -- cmdName %s\n", - tcd->aliasedCmd, methodName, ObjStr(targetObj)); - - /* - * Replace cmd and its objProc and clientData with a newly fetched - * version. - */ - cmd = Tcl_GetCommandFromObj(interp, targetObj); - if (cmd) { - cmd = GetOriginalCommand(cmd); - /*fprintf(stderr, "cmd %p epoch %d deleted %.6x\n", - cmd, - Tcl_Command_cmdEpoch(cmd), - Tcl_Command_flags(cmd) & CMD_IS_DELETED);*/ - if (Tcl_Command_flags(cmd) & CMD_IS_DELETED) { - cmd = NULL; - } - } - if (cmd == NULL) { - int result = NsfPrintError(interp, "target \"%s\" of alias %s apparently disappeared", - ObjStr(targetObj), methodName); - DECR_REF_COUNT(entryObj); - return result; - } - - assert(Tcl_Command_objProc(cmd)); - - NsfCommandRelease(tcd->aliasedCmd); - tcd->objProc = Tcl_Command_objProc(cmd); - tcd->aliasedCmd = cmd; - tcd->clientData = Tcl_Command_objClientData(cmd); - NsfCommandPreserve(tcd->aliasedCmd); - - DECR_REF_COUNT(entryObj); - /* - * Now, we should be able to proceed as planned, we have an - * non-epoched aliasCmd. - */ - } - - return MethodDispatch(self, interp, objc, objv, tcd->aliasedCmd, self, tcd->class, - methodName, 0, 0); + return NsfDispatchClientDataError(interp, NULL, "object", + Tcl_GetCommandName(interp, tcd->aliasCmd)); } @@ -17922,8 +17958,6 @@ return obj; } - - /* *---------------------------------------------------------------------- * AliasDeleteObjectReference -- @@ -17962,6 +17996,88 @@ return 0; } +/* + *---------------------------------------------------------------------- + * AliasRefetch -- + * + * Perform a refetch of an epoched aliased cmd and update the + * AliasCmdClientData structure with fresh values. + * + * Results: + * Tcl result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +AliasRefetch(Tcl_Interp *interp, NsfObject *object, CONST char *methodName, AliasCmdClientData *tcd) { + Tcl_Obj **listElements, *entryObj, *targetObj; + int nrElements, withPer_object; + NsfObject *defObject; + Tcl_Command cmd; + + assert(tcd); + defObject = tcd->class ? &(tcd->class->object) : object; + + /* + * Get the targetObject. Currently, we can get it just via the + * alias array. + */ + withPer_object = tcd->class ? 0 : 1; + entryObj = AliasGet(interp, defObject->cmdName, methodName, withPer_object, 1); + if (entryObj == NULL) { + return TCL_ERROR; + } + + INCR_REF_COUNT(entryObj); + Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements); + targetObj = listElements[nrElements-1]; + + NsfLog(interp, NSF_LOG_NOTICE, + "trying to refetch an epoched cmd %p as %s -- cmdName %s\n", + tcd->aliasedCmd, methodName, ObjStr(targetObj)); + + /* + * Replace cmd and its objProc and clientData with a newly fetched + * version. + */ + cmd = Tcl_GetCommandFromObj(interp, targetObj); + if (cmd) { + cmd = GetOriginalCommand(cmd); + /*fprintf(stderr, "cmd %p epoch %d deleted %.6x\n", + cmd, + Tcl_Command_cmdEpoch(cmd), + Tcl_Command_flags(cmd) & CMD_IS_DELETED);*/ + if (Tcl_Command_flags(cmd) & CMD_IS_DELETED) { + cmd = NULL; + } + } + if (cmd == NULL) { + int result = NsfPrintError(interp, "target \"%s\" of alias %s apparently disappeared", + ObjStr(targetObj), methodName); + DECR_REF_COUNT(entryObj); + return result; + } + + assert(Tcl_Command_objProc(cmd)); + + NsfCommandRelease(tcd->aliasedCmd); + tcd->objProc = Tcl_Command_objProc(cmd); + tcd->aliasedCmd = cmd; + tcd->clientData = Tcl_Command_objClientData(cmd); + NsfCommandPreserve(tcd->aliasedCmd); + + DECR_REF_COUNT(entryObj); + /* + * Now, we should be able to proceed as planned, we have an + * non-epoched aliasCmd. + */ + return TCL_OK; +} + + #if defined(NSF_ASSEMBLE) # include "asm/nsfAssemble.c" #else @@ -18671,6 +18787,8 @@ if (GetObjectFromString(interp, Tcl_Command_nsPtr(cmd)->fullName) == object) { newObjProc = NsfProcAliasMethod; } + // TODO: for forcing redirectors on objects, do something like + //newObjProc = NsfProcAliasMethod; /* * The new alias is pointing to an nsf object. In case no aliasMethod is @@ -18720,7 +18838,7 @@ NsfCommandPreserve(cmd); tcd = NEW(AliasCmdClientData); tcd->cmdName = object->cmdName; - tcd->interp = interp; /* just for deleting the associated variable */ + tcd->interp = interp; /* just for deleting the alias */ tcd->object = NULL; tcd->class = cl ? (NsfClass *) object : NULL; tcd->objProc = objProc; Index: generic/nsfInt.h =================================================================== diff -u -re7a27ff80df0f9c20be649e1ea1d0bc55f045739 -r7413d266916a491ff674489513351c89987366d7 --- generic/nsfInt.h (.../nsfInt.h) (revision e7a27ff80df0f9c20be649e1ea1d0bc55f045739) +++ generic/nsfInt.h (.../nsfInt.h) (revision 7413d266916a491ff674489513351c89987366d7) @@ -707,7 +707,6 @@ #define NSF_CSC_MIXIN_STACK_PUSHED 0x004000 #define NSF_CSC_FILTER_STACK_PUSHED 0x008000 #define NSF_CSC_METHOD_IS_UNKNOWN 0x010000 -#define NSF_CSC_CALL_IS_TRANSPARENT 0x020000 /* flags for call method */ #define NSF_CM_NO_UNKNOWN 0x000001 @@ -718,7 +717,7 @@ #define NSF_CM_LOCAL_METHOD 0x000020 #define NSF_CM_INTRINSIC_METHOD 0x000040 -#define NSF_CSC_COPY_FLAGS (NSF_CSC_MIXIN_STACK_PUSHED|NSF_CSC_FILTER_STACK_PUSHED|NSF_CSC_IMMEDIATE|NSF_CSC_CALL_IS_TRANSPARENT|NSF_CSC_FORCE_FRAME|NSF_CM_LOCAL_METHOD) +#define NSF_CSC_COPY_FLAGS (NSF_CSC_MIXIN_STACK_PUSHED|NSF_CSC_FILTER_STACK_PUSHED|NSF_CSC_IMMEDIATE|NSF_CSC_FORCE_FRAME|NSF_CM_LOCAL_METHOD) #define NSF_VAR_TRIGGER_TRACE 1 #define NSF_VAR_REQUIRE_DEFINED 2 Index: generic/nsfStack.c =================================================================== diff -u -rd031430eb3cfba2c9c955436df3cd1a8a9ee7984 -r7413d266916a491ff674489513351c89987366d7 --- generic/nsfStack.c (.../nsfStack.c) (revision d031430eb3cfba2c9c955436df3cd1a8a9ee7984) +++ generic/nsfStack.c (.../nsfStack.c) (revision 7413d266916a491ff674489513351c89987366d7) @@ -416,7 +416,7 @@ for (; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) { NsfCallStackContent *cscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); - if ((cscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE|NSF_CSC_CALL_IS_TRANSPARENT)) + if ((cscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE)) || (cscPtr->frameType & NSF_CSC_TYPE_INACTIVE)) { continue; } Index: tests/alias.test =================================================================== diff -u -r8c4e49a8486b47ce8caa35e9e48343accc7f2764 -r7413d266916a491ff674489513351c89987366d7 --- tests/alias.test (.../alias.test) (revision 8c4e49a8486b47ce8caa35e9e48343accc7f2764) +++ tests/alias.test (.../alias.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -92,7 +92,7 @@ ::nsf::method::alias T FOO ::nsf::classes::T::foo ? {t foo} ::T->foo - ? {t FOO} ::T->foo + ? {t FOO} ::T->FOO ? {lsort [T info methods]} {FOO foo} T method foo {} {} @@ -112,7 +112,7 @@ T method FOO {} {} ? {T info methods} {foo} ? {S info methods} {BAR} - ? {s BAR} ::S->foo + ? {s BAR} ::S->BAR ? {t foo} ::T->foo ? {S info method definition BAR} "::S public alias BAR ::nsf::classes::T::FOO" @@ -150,28 +150,28 @@ ? {t foo} ::T->foo ? {T class info method definition ZAP} {::T public class alias ZAP ::T::BAR} - ? {T FOO} ->foo - ? {T BAR} ->foo - ? {T ZAP} ->foo + ? {T FOO} ->FOO + ? {T BAR} ->BAR + ? {T ZAP} ->ZAP ? {T bar} ->bar T class method FOO {} {} #WITH_IMPORT_REFS #? {T info methods} {foo} ? {T info methods} {foo FOO} ? {lsort [T class info methods]} {BAR ZAP bar} - ? {T BAR} ->foo - ? {T ZAP} ->foo + ? {T BAR} ->BAR + ? {T ZAP} ->ZAP rename ::T::BAR "" #WITH_IMPORT_REFS #? {T info methods} {foo} ? {T info methods} {foo FOO} ? {lsort [T class info methods]} {ZAP bar} - ? {T ZAP} ->foo; # is ok, still pointing to 'foo' + ? {T ZAP} ->ZAP; # is ok, still pointing to 'foo' #WITH_IMPORT_REFS #? {T info methods} {foo} ? {T info methods} {foo FOO} ? {lsort [T class info methods]} {ZAP bar} - ? {T ZAP} ->foo + ? {T ZAP} ->ZAP T public method foo {} {} #WITH_IMPORT_REFS #? {T info methods} {} @@ -197,12 +197,12 @@ ::nsf::method::alias T -per-object M11 ::T::M1 ? {lsort [T class info methods]} {M1 M11 bar m1} ? {T m1} ->m1 - ? {T M1} ->m1 - ? {T M11} ->m1 + ? {T M1} ->M1 + ? {T M11} ->M11 T class method M1 {} {} ? {lsort [T class info methods]} {M11 bar m1} ? {T m1} ->m1 - ? {T M11} ->m1 + ? {T M11} ->M11 T class method m1 {} {} #WITH_IMPORT_REFS #? {lsort [T class info methods]} {bar} @@ -223,9 +223,9 @@ #? {lsort [T class info methods]} {FOO2 bar} ? {lsort [T class info methods]} {FOO2 M11 bar} ? {lsort [T info methods]} {BAR FOO1} - ? {T FOO2} ->foo - ? {t FOO1} ::T->foo - ? {t BAR} ::T->foo + ? {T FOO2} ->FOO2 + ? {t FOO1} ::T->FOO1 + ? {t BAR} ::T->BAR # # delete proc # @@ -248,16 +248,16 @@ namespace eval ::ns1 { proc foo args { return [current class]->[current method] } - proc bar args { return [uplevel 2 {set _}] } - proc bar2 args { upvar 2 _ __; return $__} + proc bar args { return [uplevel 1 {set _}] } + proc bar2 args { upvar 1 _ __; return $__} } ::nsf::method::alias T FOO ::ns1::foo ::nsf::method::alias T BAR ::ns1::bar ::nsf::method::alias T BAR2 ::ns1::bar2 ? {lsort [T info methods]} {BAR BAR2 FOO} set ::_ GOTYA - ? {t FOO} ::T->foo + ? {t FOO} ::T->FOO ? {t BAR} GOTYA ? {t BAR2} GOTYA namespace delete ::ns1 @@ -279,8 +279,8 @@ U public class method bar args { return [current class]->[current method] } ::nsf::method::alias U -per-object BAR ::U::bar ? {lsort [U class info methods]} {BAR ZAP bar zap} - ? {U BAR} ->bar - ? {U ZAP} ->zap + ? {U BAR} ->BAR + ? {U ZAP} ->ZAP namespace delete ::U ? {namespace exists ::U} 0 ? {lsort [U class info methods]} {} @@ -325,6 +325,7 @@ ? {lsort [V class info methods]} {FOO2 bar} } +Test case alias-store # # Tests for the ::nsf::method::alias store, used for introspection for # aliases. The alias store (an associative variable) is mostly @@ -452,7 +453,7 @@ ? {c FOO2} {target "::foo" of alias FOO2 apparently disappeared} rename ::foo2 ::foo ? {c FOO} {Could not obtain alias definition for ::C FOO.} -? {c FOO2} {::c->foo} +? {c FOO2} {::c->FOO2} # # Check resolving of namespace imported classes @@ -518,7 +519,7 @@ ? {c1 bar} 1 ? {c1 bar_} 1 - ? {c1 bar2} 0 ;# upvar reaches into to alias-redirector + ? {c1 bar2} 1 ? {d1 bar} 1 ? {d1 bar_} 1 Index: tests/destroy.test =================================================================== diff -u -re7a27ff80df0f9c20be649e1ea1d0bc55f045739 -r7413d266916a491ff674489513351c89987366d7 --- tests/destroy.test (.../destroy.test) (revision e7a27ff80df0f9c20be649e1ea1d0bc55f045739) +++ tests/destroy.test (.../destroy.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -448,6 +448,8 @@ o2 destroy ? {o a info vars} "Trying to dispatch deleted object via method 'a'" "1st call on deleted object" ? {o a info vars} "::o: unable to dispatch method 'a'" "2nd call on deleted object" + #? {o a info vars} {target "o2" of alias a apparently disappeared} "1st call on deleted object" + #? {o a info vars} {target "o2" of alias a apparently disappeared} "2nd call on deleted object" } Test case deleting-aliased-object2 { @@ -471,6 +473,8 @@ o2 destroy ? {o a info vars} "Trying to dispatch deleted object via method 'a'" "1st call on deleted object" ? {o a info vars} "::o: unable to dispatch method 'a'" "2nd call on deleted object" + #? {o a info vars} {target "o2" of alias a apparently disappeared} "1st call on deleted object" + #? {o a info vars} {target "o2" of alias a apparently disappeared} "2nd call on deleted object" } set case "deleting object with alias to object" @@ -489,7 +493,10 @@ Object create o Object create o3 ::nsf::method::alias o x o3 -o::x destroy +#o::x destroy +o3 destroy +#? {o x foo} {target "o3" of alias x apparently disappeared} +? {o x foo} {Trying to dispatch deleted object via method 'x'} ? {::nsf::object::exists o3} 0 "aliased object destroyed" o destroy @@ -531,6 +538,7 @@ ? {c1 set A} 3 "call 2nd level ok" o destroy ? {c1 b} "Trying to dispatch deleted object via method 'b'" "call via alias to deleted object" + #? {c1 b} {target "o" of alias b apparently disappeared} "call via alias to deleted object" } # Index: tests/disposition.test =================================================================== diff -u -rdfaca66a33107320eac62bde6ac8ea15abbcbe83 -r7413d266916a491ff674489513351c89987366d7 --- tests/disposition.test (.../disposition.test) (revision dfaca66a33107320eac62bde6ac8ea15abbcbe83) +++ tests/disposition.test (.../disposition.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -1122,14 +1122,10 @@ error [::nsf::current]-[::nsf::current methodpath]-[::nsf::current method] } # - # TODO: Currently, [current method] resolves to the name of the - # aliased, not the alias cmd. So, we do not have "alias - # transparency". Revise? - # ::nsf::method::alias C FOO ::foo - ? {[C create c] FOO} "::c--foo" + ? {[C create c] FOO} "::c--FOO" C setObjectParams [list [list FOO:alias,noarg ""]] - ? {C create c} "::c--foo" + ? {C create c} "::c--FOO" C public method "show me" {} { set :msg [::nsf::current]-[::nsf::current methodpath]-[::nsf::current method] } Index: tests/info-method.test =================================================================== diff -u -re7a27ff80df0f9c20be649e1ea1d0bc55f045739 -r7413d266916a491ff674489513351c89987366d7 --- tests/info-method.test (.../info-method.test) (revision e7a27ff80df0f9c20be649e1ea1d0bc55f045739) +++ tests/info-method.test (.../info-method.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -173,7 +173,7 @@ # Test visability of obj-objects # -nx::Test case sub-objects { +nx::Test case visability-sub-objects { ::nx::Object create o { ::nx::Object create [::nx::self]::sub { :method foo {} {;} @@ -192,18 +192,24 @@ # # Test visability of aliased Objects # -nx::Test case sub-objects { +nx::Test case visability-aliased-object { ::nx::Object create ::I ::nx::Class create C { :public alias i ::I :create c1 } ? {C info methods i} "" ? {c1 info lookup methods i} "" + #? {C info methods i} "i" + #? {c1 info lookup methods i} "i" + #? {C info methods *i} "i" + #? {c1 info lookup methods *i} "i" ::nsf::object::property ::I allowmethoddispatch 1 ? {C info methods i} "i" ? {c1 info lookup methods i} "i" + ? {C info methods *i} "i" + ? {c1 info lookup methods *i} "i" } @@ -603,7 +609,6 @@ ? {lsort [o info method submethods dummy]} "" ? {lsort [o info method submethods foo]} "a b" ? {lsort [o info method submethods "foo a"]} "" - ? {lsort [C info method submethods "bar"]} "a b baz" ? {lsort [C info method submethods "bar a"]} "" ? {lsort [C info method submethods "bar baz"]} "x y" Index: tests/methods.test =================================================================== diff -u -re7a27ff80df0f9c20be649e1ea1d0bc55f045739 -r7413d266916a491ff674489513351c89987366d7 --- tests/methods.test (.../methods.test) (revision e7a27ff80df0f9c20be649e1ea1d0bc55f045739) +++ tests/methods.test (.../methods.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -94,12 +94,12 @@ ? {::nsf::dispatch c2 protected_setter 4} "4" } -# class level alias ....TODO: wanted behavior of [current method]? not "plain_alias"? +# class level alias .... nx::Test case class-level-alias { - ? {c2 plain_alias} "plain_method" - ? {c2 public_alias} "public_method" + ? {c2 plain_alias} "plain_alias" + ? {c2 public_alias} "public_alias" ? {catch {c2 protected_alias}} 1 - ? {::nsf::dispatch c2 protected_alias} "protected_method" + ? {::nsf::dispatch c2 protected_alias} "protected_alias" } ########### @@ -128,12 +128,12 @@ ? {::nsf::dispatch C protected_object_setter 4} "4" } -# class level alias ....TODO: wanted behavior of [current method]? not "plain_alias"? +# class level alias .... nx::Test case class-object-level-alias { - ? {C plain_object_alias} "plain_object_method" - ? {C public_object_alias} "public_object_method" + ? {C plain_object_alias} "plain_object_alias" + ? {C public_object_alias} "public_object_alias" ? {catch {C protected_object_alias}} 1 - ? {::nsf::dispatch C protected_object_alias} "protected_object_method" + ? {::nsf::dispatch C protected_object_alias} "protected_object_alias" } ########### @@ -162,12 +162,12 @@ ? {::nsf::dispatch c1 protected_object_setter 4} "4" } -# object level alias ....TODO: wanted behavior of [current method]? not "plain_alias"? +# object level alias .... nx::Test case object-level-alias { - ? {c1 plain_object_alias} "plain_object_method" - ? {c1 public_object_alias} "public_object_method" + ? {c1 plain_object_alias} "plain_object_alias" + ? {c1 public_object_alias} "public_object_alias" ? {catch {c1 protected_object_alias}} 1 - ? {::nsf::dispatch c1 protected_object_alias} "protected_object_method" + ? {::nsf::dispatch c1 protected_object_alias} "protected_object_alias" ? {lsort [c1 info methods]} \ "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter" Index: tests/submethods.test =================================================================== diff -u -re7a27ff80df0f9c20be649e1ea1d0bc55f045739 -r7413d266916a491ff674489513351c89987366d7 --- tests/submethods.test (.../submethods.test) (revision e7a27ff80df0f9c20be649e1ea1d0bc55f045739) +++ tests/submethods.test (.../submethods.test) (revision 7413d266916a491ff674489513351c89987366d7) @@ -57,6 +57,7 @@ Foo create f1 ? {f1 baz a m1 10} m1 +puts stderr "=====1" ? {f1 baz a m3 10} \ {Unable to dispatch sub-method "m3" of ::f1 baz a; valid are: baz a m1, baz a m2}