Index: TODO =================================================================== diff -u -N -r53d0f6c3bde8bd07fb8dd0f091f9442d26539868 -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- TODO (.../TODO) (revision 53d0f6c3bde8bd07fb8dd0f091f9442d26539868) +++ TODO (.../TODO) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -3353,11 +3353,19 @@ * added flag "-keepvars" to nsf::finalize for handling cases in interp.test * reactivated tests and simplified interp.test - - disposition.test: +- disposition.test: * remove/check exit (see comments in the file) - - disposition.test: - * handle exit from eval/inticmd with proper refcounts + * handle exit from eval/inticmd with proper refcounts +- nsf.c: + * integrated "-local" and fully qualified handling with ObjectDispatch + to ensure proper behavior of mixins/next etc. + * added "/obj/ -local ..." similar to "/obj/ -system ..." + * added "nsf::object::disapatch /obj/ -local ..." similar to "/obj/ -local ..." + * extended regression test (next from -local, + fully qualified names, private methods, "...dispatch -local") + + TODO: - private: * make it mutual exclusive with protected. Index: generic/nsf.c =================================================================== diff -u -N -r9318621f9cf5544818fbb03209814fdfc8d2156c -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- generic/nsf.c (.../nsf.c) (revision 9318621f9cf5544818fbb03209814fdfc8d2156c) +++ generic/nsf.c (.../nsf.c) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -2166,24 +2166,36 @@ *---------------------------------------------------------------------- */ static NsfClass * -SearchPLMethod(register NsfClasses *pl, CONST char *methodName, Tcl_Command *cmdPtr) { +SearchPLMethod(register NsfClasses *pl, CONST char *methodName, + Tcl_Command *cmdPtr, int flags) { + /* Search the precedence list (class hierarchy) */ -#if 1 - for (; pl; pl = pl->nextPtr) { - register Tcl_HashEntry *entryPtr = - Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(pl->cl->nsPtr), methodName, NULL); - if (entryPtr != NULL) { - *cmdPtr = (Tcl_Command) Tcl_GetHashValue(entryPtr); - return pl->cl; + if (likely(flags == 0)) { + for (; pl; pl = pl->nextPtr) { + register Tcl_HashEntry *entryPtr = + Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(pl->cl->nsPtr), methodName, NULL); + if (entryPtr != NULL) { + *cmdPtr = (Tcl_Command) Tcl_GetHashValue(entryPtr); + return pl->cl; + } } - } -#else - for (; pl; pl = pl->nextPtr) { - if ((*cmdPtr = FindMethod(pl->cl->nsPtr, methodName))) { - return pl->cl; + } else { + for (; pl; pl = pl->nextPtr) { + register Tcl_HashEntry *entryPtr = + Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(pl->cl->nsPtr), methodName, NULL); + if (entryPtr != NULL) { + Tcl_Command cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + + if (Tcl_Command_flags(cmd) & flags) { + fprintf(stderr, "skipped cmd %p flags %.6x & %.6x => %.6x\n", + cmd, flags, Tcl_Command_flags(cmd), Tcl_Command_flags(cmd) & flags); + continue; + } + *cmdPtr = cmd; + return pl->cl; + } } } -#endif return NULL; } @@ -2208,7 +2220,7 @@ static NsfClass * SearchCMethod(INTERP_DECL /*@notnull@*/ NsfClass *cl, CONST char *methodName, Tcl_Command *cmdPtr) { assert(cl); - return SearchPLMethod(ComputeOrder(INTERP cl, cl->order, Super), methodName, cmdPtr); + return SearchPLMethod(ComputeOrder(INTERP cl, cl->order, Super), methodName, cmdPtr, 0); } /* @@ -2232,7 +2244,7 @@ SearchSimpleCMethod(Tcl_Interp *interp, /*@notnull@*/ NsfClass *cl, Tcl_Obj *methodObj, Tcl_Command *cmdPtr) { assert(cl); - return SearchPLMethod(ComputeOrder(INTERP cl, cl->order, Super), ObjStr(methodObj), cmdPtr); + return SearchPLMethod(ComputeOrder(INTERP cl, cl->order, Super), ObjStr(methodObj), cmdPtr, 0); } /* @@ -6618,7 +6630,7 @@ int result = TCL_OK; int cmdFlags = Tcl_Command_flags(cmd); - if ((cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) || + if (/*(cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) ||*/ ((cmdFlags & NSF_CMD_CLASS_ONLY_METHOD) && !NsfObjectIsClass(object))) { /* * The command is not applicable for objects (i.e. might crash, @@ -6642,7 +6654,8 @@ * Search for a methodname in the mixin list of the provided * object. According to the state of the mixin stack it start the search * from the beginning of from the last dispatched method shadowed method on - * the mixin path. + * the mixin path. If a class *cl and a *cmdPtr are provided, the function + * only succeeds, when the class is a mixin class. * * Results: * Tcl result code. @@ -6655,10 +6668,6 @@ * *---------------------------------------------------------------------- */ -/* - * before we can perform a mixin dispatch, MixinSearchProc seeks the - * current mixin and the relevant calling information - */ static int MixinSearchProc(Tcl_Interp *interp, NsfObject *object, CONST char *methodName, Tcl_Obj *methodObj, @@ -6672,91 +6681,67 @@ assert(object->mixinStack); assert(methodName); - /* ensure that the mixin order is not invalid, otherwise compute order */ + /* ensure that the mixin order is valid */ assert(object->flags & NSF_MIXIN_ORDER_VALID); - /*MixinComputeDefined(interp, object);*/ + cmdList = SeekCurrent(object->mixinStack->currentCmdPtr, object->mixinOrder); RUNTIME_STATE(interp)->currentMixinCmdPtr = cmdList ? cmdList->cmdPtr : NULL; - /*fprintf(stderr, "MixinSearch searching for '%s' %p\n", methodName, cmdList); - CmdListPrint(interp, "MixinSearch CL = \n", cmdList);*/ + /*fprintf(stderr,"searching for '%s' in %p\n", methodName, cmdList); + CmdListPrint(interp, "MixinSearch CL = \n", cmdList);*/ - if (*methodName == ':') { - Tcl_DString ds, *dsPtr = &ds; - Tcl_Command cmd1, lastCmdPtr = NULL; - NsfClass *cl1; - NsfObject *regObject, *defObject; - CONST char *methodName1; - int fromClassNS = 0; + if (unlikely(*clPtr && *cmdPtr)) { + Tcl_Command lastCmdPtr = NULL; - /* - * We have an abolute name provided. We have to check, whether the - * absolute refers of a class in the mixin list of the current object. If - * so, we have to advance the current cmd pointer to this cmd to allow - * next to start from this point. - */ - - if (methodObj == NULL) { - methodObj = Tcl_NewStringObj(methodName, -1); - } + /*fprintf(stderr, "... new branch\n");*/ - INCR_REF_COUNT(methodObj); - Tcl_DStringInit(dsPtr); - cmd1 = ResolveMethodName(interp, NULL, methodObj, - dsPtr, ®Object, &defObject, &methodName1, &fromClassNS); - if (cmd1 && regObject) { - /* - * The absolute name was found and refers to a name in a class. We - * iterate over the mixin list and search for the class. - */ - for (; cmdList; cmdList = cmdList->nextPtr) { - if (Tcl_Command_cmdEpoch(cmdList->cmdPtr)) { continue; } - cl1 = NsfGetClassFromCmdPtr(cmdList->cmdPtr); - assert(cl1); - lastCmdPtr = cmdList->cmdPtr; + for (; cmdList; cmdList = cmdList->nextPtr) { + NsfClass *cl1; - if ((NsfObject *)cl1 == regObject) { - /* - * The class was found. - */ - result = CanInvokeMixinMethod(interp, object, cmd1, cmdList); - /* - * No matter, what the result is, stop the search through the mixin - * classes here. - */ - if (result == NSF_CHECK_FAILED) { - result = TCL_OK; - cmd1 = NULL; - } + if (Tcl_Command_cmdEpoch(cmdList->cmdPtr)) { continue; } + cl1 = NsfGetClassFromCmdPtr(cmdList->cmdPtr); + assert(cl1); + lastCmdPtr = cmdList->cmdPtr; - cmd = cmd1; + if (cl1 == *clPtr) { + /* + * The wanted class was found. Check guards and permissions to + * determine whether we can invoke this method. + */ + result = CanInvokeMixinMethod(interp, object, *cmdPtr, cmdList); + + if (likely(result == TCL_OK)) { cl = cl1; - break; + } else if (result == NSF_CHECK_FAILED) { + result = TCL_OK; } + /* + * No matter, what the result is, stop the search through the mixin + * classes here. + */ + break; } - } - Tcl_DStringFree(dsPtr); - DECR_REF_COUNT(methodObj); - + } + if (cl) { assert(cmdList); /* * on success: return class and cmdList->cmdPtr; */ - *clPtr = cl; *currentCmdPtr = cmdList->cmdPtr; - /*fprintf(stderr, "mixinsearch returns %p (cl %s)\n", cmd, ClassName(cl));*/ + /*fprintf(stderr, "... mixinsearch success returns %p (cl %s)\n", cmd, ClassName(cl));*/ } else { /* * We did not find the absolute entry in the mixins. Set the * currentCmdPtr (on the mixin stack) to the last entry to flag, that * the mixin list should not started again on a next. */ + *cmdPtr = NULL; *currentCmdPtr = lastCmdPtr; + /*fprintf(stderr, "... mixinsearch success failure %p (cl %s)\n", cmd, ClassName(cl));*/ } - - *cmdPtr = cmd; + return result; } else { @@ -6779,6 +6764,7 @@ } result = CanInvokeMixinMethod(interp, object, cmd, cmdList); + if (unlikely(result == TCL_ERROR)) { return result; } else if (result == NSF_CHECK_FAILED) { @@ -7869,7 +7855,7 @@ } static int -ByteCompiled(Tcl_Interp *interp, unsigned short *flagsPtr, +ByteCompiled(Tcl_Interp *interp, unsigned int *flagsPtr, Proc *procPtr, CONST char *procName) { Namespace *nsPtr = procPtr->cmdPtr->nsPtr; Tcl_Obj *bodyObj = procPtr->bodyPtr; @@ -9377,7 +9363,7 @@ int validCscPtr = 1; /* none of the higher copy-flags must be passed */ - assert((flags & (NSF_CSC_COPY_FLAGS & 0xFF00)) == 0); + assert((flags & (NSF_CSC_COPY_FLAGS & 0xFFF000)) == 0); if (unlikely(flags & NSF_CM_NO_SHIFT)) { shift = 0; @@ -9388,9 +9374,16 @@ assert(objc > 1); cmdObj = objv[0]; methodName = ObjStr(objv[1]); - if (*methodName == '-' && strcmp(methodName + 1, "system") == 0) { - flags |= NSF_CM_SYSTEM_METHOD; - shift = 2; + if (unlikely(*methodName == '-')) { + if (strcmp(methodName + 1, "system") == 0) { + flags |= NSF_CM_SYSTEM_METHOD; + shift = 2; + } else if (strcmp(methodName + 1, "local") == 0) { + flags |= NSF_CM_LOCAL_METHOD; + shift = 2; + } else { + shift = 1; + } } else { shift = 1; } @@ -9460,14 +9453,91 @@ } } + if ((flags & NSF_CM_LOCAL_METHOD)) { + /* + * We require a local method. If the local method is found, we set always + * the cmd and sometimes the class (if it is a class specific method). + */ + NsfCallStackContent *cscPtr1 = CallStackGetTopFrame0(interp); + + if (unlikely(cscPtr1 == NULL)) { + return NsfPrintError(interp, "local flag only allowed when called from a method body"); + } + if (cscPtr1->cl) { + cmd = FindMethod(cscPtr1->cl->nsPtr, methodName); + if (cmd) { + cl = cscPtr1->cl; + } + } else { + cmd = FindMethod(object->nsPtr, methodName); + } + + fprintf(stderr, "ObjectDispatch NSF_CM_LOCAL_METHOD obj %s methodName %s => cl %p %s cmd %p \n", + object ? ObjectName(object) : NULL, + methodName, cl, cl ? ClassName(cl) : "NONE", cmd); + + } else if (*methodName == ':') { + NsfObject *regObject, *defObject; + Tcl_DString ds, *dsPtr = &ds; + CONST char *methodName1; + int fromClassNS = 0; + + /* + * We have fully qualified name provided. Determine the class and/or + * object on which the method was registered. + */ + + if (methodObj == NULL) { + methodObj = Tcl_NewStringObj(methodName, -1); + } + + INCR_REF_COUNT(methodObj); + Tcl_DStringInit(dsPtr); + cmd = ResolveMethodName(interp, NULL, methodObj, + dsPtr, ®Object, &defObject, &methodName1, &fromClassNS); + Tcl_DStringFree(dsPtr); + if (cmd) { + if (regObject) { + if (NsfObjectIsClass(regObject)) { + cl = (NsfClass *)regObject; + } + } else { + Tcl_ObjCmdProc *procPtr = Tcl_Command_objProc(cmd); + + /*fprintf(stderr, "fully qualified lookup of %s returned %p\n", ObjStr(methodObj), cmd);*/ + if (procPtr == NsfObjDispatch) { + /* + * Don't allow to call objects as methods (for the time being) + * via fully qualified names. Otherwise, in line {2} below, ::State + * is interpreted as an ensemble object, and the method + * "unknown" won't be called (in the XOTcl tradition) and + * wierd things will happen. + * + * {1} Class ::State + * {2} Class ::State -parameter x + */ + NsfLog(interp, NSF_LOG_NOTICE, + "Don't invoke object %s this way. Register object via alias...", + methodName); + cmd = NULL; + } + } + } + + /*fprintf(stderr, "ObjectDispatch fully qualified obj %s methodName %s => cl %p cmd %p \n", + object ? ObjectName(object) : NULL, + methodName, cl, cmd);*/ + } + /*fprintf(stderr, "MixinStackPush check for %p %s.%s objflags %.6x == %d\n", object, ObjectName(object), methodName, objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID, (objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) == NSF_MIXIN_ORDER_DEFINED_AND_VALID);*/ /* * Check if a mixed in method has to be called. */ - if ((objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) == NSF_MIXIN_ORDER_DEFINED_AND_VALID && - (flags & NSF_CM_SYSTEM_METHOD) == 0) { + if ((objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) == NSF_MIXIN_ORDER_DEFINED_AND_VALID + && (flags & NSF_CM_SYSTEM_METHOD) == 0 + && ((flags & NSF_CM_LOCAL_METHOD) == 0 || cl)) { /* * The current logic allocates first an entry on the per-object @@ -9481,72 +9551,33 @@ flags |= NSF_CSC_MIXIN_STACK_PUSHED; if (frameType != NSF_CSC_TYPE_ACTIVE_FILTER) { + Tcl_Command cmd1 = cmd; /* * The entry is just searched and pushed on the stack when we * have no filter; in the filter case, the search happens in * next. */ result = MixinSearchProc(interp, object, methodName, methodObj, &cl, - &object->mixinStack->currentCmdPtr, &cmd); + &object->mixinStack->currentCmdPtr, &cmd1); if (result != TCL_OK) { /*fprintf(stderr, "mixinsearch returned an error for %p %s.%s\n", object, ObjectName(object), methodName);*/ cscPtr = CscAlloc(interp, &csc, NULL); CscInit(INTERP cscPtr, object, cl, NULL, frameType, flags, methodName); goto exit_object_dispatch; } - if (cmd) { + if (cmd1) { frameType = NSF_CSC_TYPE_ACTIVE_MIXIN; - } + cmd = cmd1; + } } } - /* - * Check if an absolute method name was provided - */ - if (unlikely(cmd == NULL && *methodName == ':')) { - - cmd = Tcl_GetCommandFromObj(interp, methodObj); - if (cmd) { - Tcl_ObjCmdProc *procPtr = Tcl_Command_objProc(cmd); - CONST char *className; - - /*fprintf(stderr, "absolute lookup of %s returned %p\n", ObjStr(methodObj), cmd);*/ - if (procPtr == NsfObjDispatch) { - /* - * Don't allow to call objects as methods (for the time being) - * via absolute names. Otherwise, in line {2} below, ::State - * is interpreted as an ensemble object, and the method - * "unknown" won't be called (in the XOTcl tradition) and - * wierd things will happen. - * - * {1} Class ::State - * {2} Class ::State -parameter x - */ - NsfLog(interp, NSF_LOG_NOTICE, - "Don't invoke object %s this way. Register object via alias...", - methodName); - cmd = NULL; - - } else if (IsClassNsName(methodName, &className)) { - /* - * Supply class cl with the with the class containing the method for - * proper continuation in a "next". - */ - CONST char *mn = Tcl_GetCommandName(interp, cmd); - Tcl_DString ds, *dsPtr = &ds; - - DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, className, strlen(className) - strlen(mn) - 2); - cl = (NsfClass *)GetObjectFromString(interp, Tcl_DStringValue(dsPtr)); - DSTRING_FREE(dsPtr); - } - } - } - /* - * If no filter/mixin is found => do ordinary method lookup + * If no fully qualified method name/filter/mixin was found then perform + * ordinary method lookup. */ + if (likely(cmd == NULL)) { /* do we have a object-specific proc? */ if (object->nsPtr && (flags & (NSF_CM_NO_OBJECT_METHOD|NSF_CM_SYSTEM_METHOD)) == 0) { @@ -9576,9 +9607,9 @@ for (; classList; classList = classList->nextPtr) { if (IsBaseClass(classList->cl)) {break;} } - cl = SearchPLMethod(classList, methodName, &cmd); + cl = SearchPLMethod(classList, methodName, &cmd, NSF_CMD_CALL_PROTECTED_METHOD); } else { - cl = SearchPLMethod(currentClass->order, methodName, &cmd); + cl = SearchPLMethod(currentClass->order, methodName, &cmd, NSF_CMD_CALL_PRIVATE_METHOD); } } } @@ -9591,8 +9622,7 @@ if (cmd) { int cmdFlags = Tcl_Command_flags(cmd); - - if (cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) { + if ((cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) && (flags & NSF_CM_LOCAL_METHOD) == 0) { /* reset cmd, since it is still unknown */ cmd = NULL; } else if ((cmdFlags & NSF_CMD_CALL_PROTECTED_METHOD) && @@ -11469,7 +11499,6 @@ */ CONST char *fullMethodName = ObjStr(procNameObj); Tcl_CallFrame *framePtr; - unsigned short dummy; Proc *procPtr; /*fprintf(stderr, "fullMethodName %s epoch %d\n", fullMethodName, Tcl_Command_cmdEpoch(cmd));*/ @@ -11508,6 +11537,7 @@ (FRAME_IS_PROC)); if (result == TCL_OK) { + unsigned int dummy; result = ByteCompiled(interp, &dummy, procPtr, fullMethodName); } if (result != TCL_OK) { @@ -12316,6 +12346,8 @@ int *endOfFilterChain, Tcl_Command *currentCmdPtr) { int endOfChain = 0, objflags; + /*fprintf(stderr, "NextSearchMethod for %s called with cl %p\n", *methodNamePtr, *clPtr);*/ + /* * Next in filters */ @@ -12381,6 +12413,8 @@ } } + + /*fprintf(stderr, "nextsearch: object %s nsPtr %p endOfChain %d\n", ObjectName(object), object->nsPtr, endOfChain);*/ @@ -12391,14 +12425,17 @@ * past our last point; otherwise (if clPtr==NULL) begin from the start. * * When a mixin or filter chain reached its end, we have to check for - * absolute method names and search the obj-specific methods as well. + * fully qualified method names and search the obj-specific methods as well. */ if (endOfChain) { if (**methodNamePtr == ':') { *cmdPtr = Tcl_FindCommand(interp, *methodNamePtr, NULL, TCL_GLOBAL_ONLY); /* fprintf(stderr, "NEXT found abolute cmd %s => %p\n", *methodNamePtr, *cmdPtr); */ } else if (object->nsPtr) { *cmdPtr = FindMethod(object->nsPtr, *methodNamePtr); + if (*cmdPtr && (Tcl_Command_flags(*cmdPtr) & NSF_CMD_CALL_PRIVATE_METHOD)) { + *cmdPtr = NULL; + } } else { *cmdPtr = NULL; } @@ -12410,18 +12447,25 @@ *methodNamePtr, *clPtr, ClassName((*clPtr)), *cmdPtr); */ if (!*cmdPtr) { - NsfClasses *pl; + NsfClasses *pl = ComputeOrder(INTERP object->cl, object->cl->order, Super); + NsfClass *cl = *clPtr; - for (pl = ComputeOrder(INTERP object->cl, object->cl->order, Super); *clPtr && pl; pl = pl->nextPtr) { - if (pl->cl == *clPtr) { - *clPtr = NULL; + if (cl) { + /* + * Skip until actual class + */ + for ( ; pl; pl = pl->nextPtr) { + if (pl->cl == cl) { + pl = pl->nextPtr; + break; + } } } /* - * search for a further class method + * Search for a further class method */ - *clPtr = SearchPLMethod(pl, *methodNamePtr, cmdPtr); + *clPtr = SearchPLMethod(pl, *methodNamePtr, cmdPtr, NSF_CMD_CALL_PRIVATE_METHOD); } else { *clPtr = NULL; @@ -12625,7 +12669,7 @@ int objc, Tcl_Obj *CONST objv[], NsfCallStackContent *cscPtr, int freeArgumentVector) { - Tcl_Command cmd, currentCmd = NULL; + Tcl_Command cmd = NULL, currentCmd = NULL; int result, isMixinEntry = 0, isFilterEntry = 0, endOfFilterChain = 0; NsfRuntimeState *rst = RUNTIME_STATE(interp); @@ -12836,7 +12880,7 @@ static int FindSelfNext(Tcl_Interp *interp) { NsfCallStackContent *cscPtr = CallStackGetTopFrame0(interp); - Tcl_Command cmd, currentCmd = NULL; + Tcl_Command cmd = NULL, currentCmd = NULL; int result, isMixinEntry = 0, isFilterEntry = 0, endOfFilterChain = 0; @@ -17997,14 +18041,15 @@ cmd "object::dispatch" NsfObjectDispatchCmd { {-argName "object" -required 1 -type object} {-argName "-frame" -required 0 -nrargs 1 -type "method|object|default" -default "default"} + {-argName "-local" -required 0 -nrargs 0} {-argName "-system" -required 0 -nrargs 0} {-argName "command" -required 1 -type tclobj} {-argName "args" -type args} } */ static int NsfObjectDispatchCmd(Tcl_Interp *interp, NsfObject *object, - int withFrame, int withSystem, + int withFrame, int withLocal, int withSystem, Tcl_Obj *command, int nobjc, Tcl_Obj *CONST nobjv[]) { int result; CONST char *methodName = ObjStr(command); @@ -18024,10 +18069,10 @@ int flags = 0; /* - * We have an absolute name. We assume, the name is the name of a + * We have a fully qualified name. We assume, the name is the name of a * Tcl command, that will be dispatched. If "withFrame == instance" is - * specified, a callstack frame is pushed to make instvars - * accessible for the command. + * specified, a callstack frame is pushed to make instvars accessible for + * the command. */ cmd = Tcl_GetCommandFromObj(interp, command); @@ -18091,9 +18136,8 @@ methodName); } - if (withSystem) { - flags |= NSF_CM_SYSTEM_METHOD; - } + if (withSystem) {flags |= NSF_CM_SYSTEM_METHOD;} + if (withLocal) {flags |= NSF_CM_LOCAL_METHOD;} if (nobjc >= 1) { arg = nobjv[0]; @@ -18298,50 +18342,36 @@ int withLocal, int withSystem, Tcl_Obj *methodObj, int nobjc, Tcl_Obj *CONST nobjv[]) { NsfObject *self = GetSelfObj(interp); - int result; + int flags, result; if (!self) { return NsfNoCurrentObjectError(interp, ObjStr(nobjv[0])); } - if (withLocal) { - CONST char *methodName = ObjStr(methodObj); - NsfCallStackContent *cscPtr = CallStackGetTopFrame0(interp); - NsfClass *cl = cscPtr ? cscPtr->cl : NULL; - Tcl_Command cmd = cl ? FindMethod(cl->nsPtr, methodName) : FindMethod(self->nsPtr, methodName); + if (withSystem && withLocal) { + return NsfPrintError(interp, "flags '-local' and '-system' are mutual exclusive"); + } - if (withSystem) { - return NsfPrintError(interp, "flags '-local' and '-systemÄ are mutual exclusive"); - } - - if (cmd == NULL) { - return NsfPrintError(interp, "%s: unable to dispatch local method '%s' in %s %s", - ObjectName(self), methodName, - cl ? "class" : "object", - cl ? ClassName(cl) : ObjectName(self)); - } - result = MethodDispatch(self, interp, nobjc+1, nobjv-1, cmd, self, cl, - methodName, 0, NSF_CSC_IMMEDIATE); - } else { - int flags; #if 0 - /* TODO attempt to make "my" NRE-enabled, failed so far (crash in mixinInheritanceTest) */ - NsfCallStackContent *cscPtr = CallStackGetTopFrame0(interp); - if (!cscPtr || self != cscPtr->self) { - flags = NSF_CSC_IMMEDIATE; - } else { - flags = NsfImmediateFromCallerFlags(cscPtr->flags); - fprintf(stderr, "XXX MY %s.%s frame has flags %.6x -> next-flags %.6x\n", - ObjectName(self), ObjStr(methodObj), cscPtr->flags, flags); - } - if (withSystem) {flags |= NSF_CM_SYSTEM_METHOD;} - result = CallMethod(self, interp, methodObj, nobjc+2, nobjv, flags); -#else + /* TODO attempt to make "my" NRE-enabled, failed so far (crash in mixinInheritanceTest) */ + NsfCallStackContent *cscPtr = CallStackGetTopFrame0(interp); + if (!cscPtr || self != cscPtr->self) { flags = NSF_CSC_IMMEDIATE; - if (withSystem) {flags |= NSF_CM_SYSTEM_METHOD;} - result = CallMethod(self, interp, methodObj, nobjc+2, nobjv, flags); -#endif + } else { + flags = NsfImmediateFromCallerFlags(cscPtr->flags); + fprintf(stderr, "XXX MY %s.%s frame has flags %.6x -> next-flags %.6x\n", + ObjectName(self), ObjStr(methodObj), cscPtr->flags, flags); } + if (withLocal) {flags |= NSF_CM_LOCAL_METHOD;} + if (withSystem) {flags |= NSF_CM_SYSTEM_METHOD;} + result = CallMethod(self, interp, methodObj, nobjc+2, nobjv, flags); +#else + flags = NSF_CSC_IMMEDIATE; + if (withSystem) {flags |= NSF_CM_SYSTEM_METHOD;} + if (withLocal) {flags |= NSF_CM_LOCAL_METHOD;} + result = CallMethod(self, interp, methodObj, nobjc+2, nobjv, flags); +#endif + return result; } Index: generic/nsfAPI.decls =================================================================== diff -u -N -r9318621f9cf5544818fbb03209814fdfc8d2156c -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 9318621f9cf5544818fbb03209814fdfc8d2156c) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -112,6 +112,7 @@ cmd "object::dispatch" NsfObjectDispatchCmd { {-argName "object" -required 1 -type object} {-argName "-frame" -required 0 -type "method|object|default" -default "default"} + {-argName "-local" -required 0 -nrargs 0} {-argName "-system" -required 0 -nrargs 0} {-argName "command" -required 1 -type tclobj} {-argName "args" -type args} Index: generic/nsfAPI.h =================================================================== diff -u -N -r9318621f9cf5544818fbb03209814fdfc8d2156c -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- generic/nsfAPI.h (.../nsfAPI.h) (revision 9318621f9cf5544818fbb03209814fdfc8d2156c) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -349,7 +349,7 @@ static int NsfNSCopyCmdsCmd(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int NsfNSCopyVarsCmd(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int NsfNextCmd(Tcl_Interp *interp, Tcl_Obj *arguments); -static int NsfObjectDispatchCmd(Tcl_Interp *interp, NsfObject *object, int withFrame, int withSystem, Tcl_Obj *command, int nobjc, Tcl_Obj *CONST nobjv[]); +static int NsfObjectDispatchCmd(Tcl_Interp *interp, NsfObject *object, int withFrame, int withLocal, int withSystem, Tcl_Obj *command, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfObjectExistsCmd(Tcl_Interp *interp, Tcl_Obj *value); static int NsfObjectPropertyCmd(Tcl_Interp *interp, NsfObject *objectName, int objectproperty); static int NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *objectName); @@ -1415,11 +1415,12 @@ } else { NsfObject *object = (NsfObject *)pc.clientData[0]; int withFrame = (int )PTR2INT(pc.clientData[1]); - int withSystem = (int )PTR2INT(pc.clientData[2]); - Tcl_Obj *command = (Tcl_Obj *)pc.clientData[3]; + int withLocal = (int )PTR2INT(pc.clientData[2]); + int withSystem = (int )PTR2INT(pc.clientData[3]); + Tcl_Obj *command = (Tcl_Obj *)pc.clientData[4]; assert(pc.status == 0); - return NsfObjectDispatchCmd(interp, object, withFrame, withSystem, command, objc-pc.lastObjc, objv+pc.lastObjc); + return NsfObjectDispatchCmd(interp, object, withFrame, withLocal, withSystem, command, objc-pc.lastObjc, objv+pc.lastObjc); } } @@ -2544,9 +2545,10 @@ {"::nsf::next", NsfNextCmdStub, 1, { {"arguments", 0, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::object::dispatch", NsfObjectDispatchCmdStub, 5, { +{"::nsf::object::dispatch", NsfObjectDispatchCmdStub, 6, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, {"-frame", 0|NSF_ARG_IS_ENUMERATION, 1, ConvertToFrame, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"-local", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"-system", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"command", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"args", 0, 1, ConvertToNothing, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} Index: generic/nsfInt.h =================================================================== diff -u -N -r05101e4e8362d0901d36787f88309d945e28fe41 -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- generic/nsfInt.h (.../nsfInt.h) (revision 05101e4e8362d0901d36787f88309d945e28fe41) +++ generic/nsfInt.h (.../nsfInt.h) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -683,8 +683,8 @@ NsfFilterStack *filterStackEntry; Tcl_Obj *CONST* objv; int objc; + unsigned int flags; unsigned short frameType; - unsigned short flags; #if defined(NSF_PROFILE) || defined(NSF_DTRACE) long int startUsec; long int startSec; @@ -701,26 +701,30 @@ #define NSF_CSC_TYPE_GUARD 0x10 #define NSF_CSC_TYPE_ENSEMBLE 0x20 -#define NSF_CSC_CALL_IS_NEXT 1 -#define NSF_CSC_CALL_IS_GUARD 2 -#define NSF_CSC_CALL_IS_ENSEMBLE 4 -#define NSF_CSC_CALL_IS_COMPILE 8 -#define NSF_CSC_IMMEDIATE 0x0020 -#define NSF_CSC_FORCE_FRAME 0x0040 -#define NSF_CSC_CALL_NO_UNKNOWN 0x0080 -#define NSF_CSC_CALL_IS_NRE 0x0100 -#define NSF_CSC_MIXIN_STACK_PUSHED 0x0400 -#define NSF_CSC_FILTER_STACK_PUSHED 0x0800 -#define NSF_CSC_METHOD_IS_UNKNOWN 0x1000 -#define NSF_CSC_CALL_IS_TRANSPARENT 0x2000 +#define NSF_CSC_CALL_IS_NEXT 1 +#define NSF_CSC_CALL_IS_GUARD 2 +#define NSF_CSC_CALL_IS_ENSEMBLE 4 +#define NSF_CSC_CALL_IS_COMPILE 8 + + +#define NSF_CSC_IMMEDIATE 0x000100 +#define NSF_CSC_FORCE_FRAME 0x000200 +#define NSF_CSC_CALL_NO_UNKNOWN 0x000400 +#define NSF_CSC_CALL_IS_NRE 0x002000 +#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 #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) /* flags for call method */ -#define NSF_CM_NO_UNKNOWN 0x01 -#define NSF_CM_NO_SHIFT 0x02 -#define NSF_CM_NO_PROTECT 0x04 -#define NSF_CM_NO_OBJECT_METHOD 0x08 -#define NSF_CM_SYSTEM_METHOD 0x10 +#define NSF_CM_NO_UNKNOWN 0x000001 +#define NSF_CM_NO_SHIFT 0x000002 +#define NSF_CM_NO_PROTECT 0x000004 +#define NSF_CM_NO_OBJECT_METHOD 0x000008 +#define NSF_CM_SYSTEM_METHOD 0x000010 +#define NSF_CM_LOCAL_METHOD 0x000020 +#define NSF_CM_INTRINSIC_METHOD 0x000040 #define NSF_VAR_TRIGGER_TRACE 1 #define NSF_VAR_REQUIRE_DEFINED 2 Index: tests/destroy.test =================================================================== diff -u -N -ra24e1f836c3126d0a0e9467bde3a9fa8da901711 -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- tests/destroy.test (.../destroy.test) (revision a24e1f836c3126d0a0e9467bde3a9fa8da901711) +++ tests/destroy.test (.../destroy.test) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -451,6 +451,7 @@ ? {o a set x} 10 "set var via alias" o2 destroy ? {o a info vars} "Trying to dispatch deleted object via method 'a'" "1st call on deleted object" + puts stderr ====1 ? {o a info vars} "::o: unable to dispatch method 'a'" "2nd call on deleted object" } Index: tests/disposition.test =================================================================== diff -u -N -ra24e1f836c3126d0a0e9467bde3a9fa8da901711 -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- tests/disposition.test (.../disposition.test) (revision a24e1f836c3126d0a0e9467bde3a9fa8da901711) +++ tests/disposition.test (.../disposition.test) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -1304,6 +1304,7 @@ ? {T create tt YYY} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD-YYY-PATH-z" \ "sending the msg: tt->z(::obj)->YYY()" + ::obj mixin {} T setObjectParams [list -z:alias] ? {T create tt -z YYY} "::obj: unable to dispatch method 'YYY'" "sending the msg: tt->z(::obj)->YYY()" @@ -1323,22 +1324,20 @@ T setObjectParams [list -z:alias] ? {T create tt -z ""} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD--PATH-z" "sending the msg: tt->z()" + # - # ISSUE: Any direct dispatch with a FQ selector is forbidden, why? + # Dispatch with a method handle # ::T mixin {} ? [list [T create t] $methods(z) XXX] \ - "::t: unable to dispatch method '::nsf::classes::T::z'" + "CURRENT-::obj-DELEGATOR-::t-UNKNOWNMETHOD-XXX-PATH-::nsf::classes::T::z" - # - # This it at least consistent :) - # T setObjectParams x:alias,method=$methods(z) - ? {T create t XXX} "::t: unable to dispatch method '$methods(z)'" \ + ? {T create t XXX} "CURRENT-::obj-DELEGATOR-::t-UNKNOWNMETHOD-XXX-PATH-::nsf::classes::T::z" \ "Non-object FQ selector with default unknown handler" ::T mixin UnknownHandler - ? {T create t XXX} "UNKNOWNMETHOD-::nsf::classes::T::z" \ + ? {T create t XXX} "CURRENT-::obj-DELEGATOR-::t-UNKNOWNMETHOD-XXX-PATH-::nsf::classes::T::z" \ "Non-object FQ selector with custom unknown handler" # Index: tests/interceptor-slot.test =================================================================== diff -u -N -r88d8fd1e2b40d5797eb86a0be4c5cae7c595fac6 -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- tests/interceptor-slot.test (.../interceptor-slot.test) (revision 88d8fd1e2b40d5797eb86a0be4c5cae7c595fac6) +++ tests/interceptor-slot.test (.../interceptor-slot.test) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -206,6 +206,8 @@ } + +Test parameter count 1 # # Test the next-path with just intrinsic classes in cases where a # method handle is used for method dispatch @@ -226,7 +228,19 @@ ? {nsf::object::dispatch c1 foo} "C B A " ? {nsf::object::dispatch c1 [C info method origin foo]} "C C B A " ? {nsf::object::dispatch c1 [B info method origin foo]} "B C B A " - ? {nsf::object::dispatch c1 [A info method origin foo]} "A C B A " + ? {nsf::object::dispatch c1 [A info method origin foo]} "A C B A " + + # + # check, whether the context of "my -local" is correct + # + A public method bar {} {nsf::my -local foo} + B public method bar {} {nsf::my -local foo} + C public method bar {} {nsf::my -local foo} + + ? {c1 bar} "C B A " + ? {c1 [C info method origin bar]} "C B A " + ? {c1 [B info method origin bar]} "B A " + ? {c1 [A info method origin bar]} "A " } # @@ -264,6 +278,53 @@ ? {c1 [Z info method origin foo]} "Z Y " ? {c1 [Y info method origin foo]} "Y " + # + # check, whether the context of "my -local" is correct + # + A public method bar {} {nsf::my -local foo} + B public method bar {} {nsf::my -local foo} + C public method bar {} {nsf::my -local foo} + Y public method bar {} {nsf::my -local foo} + Z public method bar {} {nsf::my -local foo} + + ? {c1 bar} "C B A Z Y " + ? {c1 [C info method origin bar]} "C B A Z Y " + ? {c1 [B info method origin bar]} "B A Z Y " + ? {c1 [A info method origin bar]} "A Z Y " + ? {c1 [Z info method origin bar]} "Z Y " + ? {c1 [Y info method origin bar]} "Y " + + # + # check, whether the context of "[self] -local" is correct + # + A public method bar {} {[self] -local foo} + B public method bar {} {[self] -local foo} + C public method bar {} {[self] -local foo} + Y public method bar {} {[self] -local foo} + Z public method bar {} {[self] -local foo} + + ? {c1 bar} "C B A Z Y " + ? {c1 [C info method origin bar]} "C B A Z Y " + ? {c1 [B info method origin bar]} "B A Z Y " + ? {c1 [A info method origin bar]} "A Z Y " + ? {c1 [Z info method origin bar]} "Z Y " + ? {c1 [Y info method origin bar]} "Y " + + # + # check, whether the context of "nsf::object::dispatch [self] -local" is correct + # + A public method bar {} {nsf::object::dispatch [self] -local foo} + B public method bar {} {nsf::object::dispatch [self] -local foo} + C public method bar {} {nsf::object::dispatch [self] -local foo} + Y public method bar {} {nsf::object::dispatch [self] -local foo} + Z public method bar {} {nsf::object::dispatch [self] -local foo} + + ? {c1 bar} "C B A Z Y " + ? {c1 [C info method origin bar]} "C B A Z Y " + ? {c1 [B info method origin bar]} "B A Z Y " + ? {c1 [A info method origin bar]} "A Z Y " + ? {c1 [Z info method origin bar]} "Z Y " + ? {c1 [Y info method origin bar]} "Y " } Index: tests/protected.test =================================================================== diff -u -N -r29ed0c8902296dbea451c12d031cc06b6126dd5b -rf67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161 --- tests/protected.test (.../protected.test) (revision 29ed0c8902296dbea451c12d031cc06b6126dd5b) +++ tests/protected.test (.../protected.test) (revision f67408d8e6f8ba9bdd6e4ec3c54dfa3a23576161) @@ -142,7 +142,7 @@ ? {s1 foo 3 4} 7 ? {s1 bar 3 4} 12 ? {s1 baz 3 4} {::s1: unable to dispatch method 'baz'} -} +} # # test "nsf::my -local" on objects @@ -171,7 +171,7 @@ } # -# test nsf::my + patch instead of "nsf::my -local" on classes +# test nsf::my + path instead of "nsf::my -local" on classes # nx::Test case my+handle-instead-of-my-local { @@ -257,4 +257,79 @@ ? {nsf::object::exists c1} 1 ? {c1 -system destroy} "" ? {nsf::object::exists c1} 0 +} + +# +# Check my-local + private + next +# +# Never call a private method via "next", but allow "next" from +# private methods +# + +nx::Test case class-my-local+next { + + nx::Class create Base { + :private method baz {a b} { expr {$a + $b} } + :protected method baz2 {a b} { expr {$a + $b} } + :public method foo {a b} { nsf::my -local baz $a $b } + :create b1 + } + # we can call Base.baz only through Base.foo + ? {b1 foo 4 5} 9 + ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'} + + # Define and register a mixin class, where method "foo" is calling a + # private method via "my -local" + nx::Class create Mix { + :private method baz {a b} { expr {$a ** $b} } + :public method foo {a b} { nsf::my -local baz $a $b } + } + + b1 mixin add Mix + + # we can call Mix.baz only through Mix.foo + ? {b1 foo 4 5} 1024 + ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'} + + # + # the private method has a next + # + nx::Class create Intermediate -superclass Base { + :private method baz {a b} { next } + :private method baz2 {a b} { next } + :public method foo {a b} { nsf::my -local baz $a $b } + :public method foo2 {a b} { nsf::my -local baz2 $a $b } + :create i1 + } + + # next in the private method reaches a private method, which is ignored + ? {i1 foo 4 5} "" + ? {i1 baz 4 5} {::i1: unable to dispatch method 'baz'} + # next in the private method reaches a non-private method, which is honored + ? {i1 foo2 4 5} 9 + + nx::Class create Sub -superclass Intermediate { + :public method bar {a b} { puts stderr "Sub.bar->local.baz";nsf::my -local baz $a $b } + :private method baz {a b} { puts stderr "Sub.private.baz";expr {$a * $b} } + + :create s1 + } + + # next in the private method reaches a private method, which is ignored + ? {s1 foo 4 5} "" + ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'} + # next in the private method reaches a non-private method, which is honored + ? {s1 foo2 4 5} 9 + ? {s1 bar 4 5} 20 + + # add per-class mixin + Sub mixin add Mix + + # foo is shadowed in the mixin and calls the mixin-private method + ? {s1 foo 4 5} 1024 + ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'} + + # next in the private method reaches a non-private method, which is honored + ? {s1 foo2 4 5} 9 + ? {s1 bar 4 5} 20 } \ No newline at end of file