Index: generic/xotcl.c =================================================================== diff -u -rf6775105babd749f662856c7eff1a903636e80e0 -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 --- generic/xotcl.c (.../xotcl.c) (revision f6775105babd749f662856c7eff1a903636e80e0) +++ generic/xotcl.c (.../xotcl.c) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02) @@ -90,7 +90,7 @@ XOTCLINLINE static void GuardAdd(Tcl_Interp *interp, XOTclCmdList *filterCL, Tcl_Obj *guard); static int GuardCheck(Tcl_Interp *interp, Tcl_Obj *guards); static int GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd, Tcl_Interp *interp, - Tcl_Obj *guard, XOTclCallStackContent *csc); + Tcl_Obj *guard, XOTclCallStackContent *cscPtr); static void GuardDel(XOTclCmdList *filterCL); static int IsMetaClass(Tcl_Interp *interp, XOTclClass *cl, int withMixins); static int hasMixin(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl); @@ -261,7 +261,7 @@ Tcl_Obj *CONST objv[], int flags); static int XOTclNextMethod(XOTclObject *obj, Tcl_Interp *interp, XOTclClass *givenCl, char *givenMethod, int objc, Tcl_Obj *CONST objv[], - int useCSObjs, XOTclCallStackContent *csc); + int useCSObjs, XOTclCallStackContent *cscPtr); static int XOTclForwardMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -4170,7 +4170,7 @@ static int GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd, - Tcl_Interp *interp, Tcl_Obj *guard, XOTclCallStackContent *csc) { + Tcl_Interp *interp, Tcl_Obj *guard, XOTclCallStackContent *cscPtr) { int result = TCL_OK; if (guard) { @@ -4185,8 +4185,8 @@ * like in the proc. */ #if defined(TCL85STACK) - if (csc) { - XOTcl_PushFrameCsc(interp, obj, csc); + if (cscPtr) { + XOTcl_PushFrameCsc(interp, obj, cscPtr); } else { XOTcl_PushFrameObj(interp, obj); } @@ -4196,7 +4196,7 @@ #endif result = GuardCheck(interp, guard); - if (csc) { + if (cscPtr) { XOTcl_PopFrameCsc(interp, obj); } else { XOTcl_PopFrameObj(interp, obj); @@ -5151,7 +5151,7 @@ static int PushProcCallFrame(ClientData clientData, register Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], - XOTclCallStackContent *csc) { + XOTclCallStackContent *cscPtr) { Proc *procPtr = (Proc *) clientData; CallFrame *framePtr; int result; @@ -5165,10 +5165,10 @@ */ #if defined(TCL85STACK_TRACE) - fprintf(stderr, "PUSH METHOD_FRAME (PushProcCallFrame) csc %p %s obj %s obj refcount %d\n", csc, - csc ? Tcl_GetCommandName(interp, csc->cmdPtr) : NULL, - objectName(csc->self), - csc && csc->self->id ? Tcl_Command_refCount(csc->self->id) : -100 + fprintf(stderr, "PUSH METHOD_FRAME (PushProcCallFrame) csc %p %s obj %s obj refcount %d\n", cscPtr, + cscPtr ? Tcl_GetCommandName(interp, cscPtr->cmdPtr) : NULL, + objectName(cscPtr->self), + cscPtr && cscPtr->self->id ? Tcl_Command_refCount(cscPtr->self->id) : -100 ); #endif @@ -5184,9 +5184,9 @@ framePtr->objv = objv; framePtr->procPtr = procPtr; #if defined(TCL85STACK_TRACE) - fprintf(stderr, " put csc %p into frame %p flags %.4x\n", csc, framePtr, framePtr->isProcCallFrame); + fprintf(stderr, " put csc %p into frame %p flags %.4x\n", cscPtr, framePtr, framePtr->isProcCallFrame); #endif - framePtr->clientData = (ClientData)csc; + framePtr->clientData = (ClientData)cscPtr; return ByteCompiled(interp, procPtr, TclGetString(objv[0])); } @@ -5540,6 +5540,8 @@ # endif #endif result = ProcessMethodArguments(pcPtr, interp, obj, 1, paramDefs, methodName, objc, objv); + cscPtr->objc = objc; + cscPtr->objv = (Tcl_Obj **)objv; if (result == TCL_OK) { releasePc = 1; result = PushProcCallFrame(cp, interp, pcPtr->objc, pcPtr->full_objv, cscPtr); @@ -5665,7 +5667,6 @@ */ /*fprintf(stderr, "XOTcl_PushFrameCsc %s %s\n",objectName(obj), methodName);*/ XOTcl_PushFrameCsc(interp, obj, cscPtr); - /*XOTcl_PushFrameObj(interp, obj);*/ } #endif @@ -7060,7 +7061,7 @@ static int XOTclNextMethod(XOTclObject *obj, Tcl_Interp *interp, XOTclClass *givenCl, char *givenMethod, int objc, Tcl_Obj *CONST objv[], - int useCallstackObjs, XOTclCallStackContent *csc) { + int useCallstackObjs, XOTclCallStackContent *cscPtr) { Tcl_Command cmd, currentCmd = NULL; int result, frameType = XOTCL_CSC_TYPE_PLAIN, isMixinEntry = 0, isFilterEntry = 0, @@ -7070,11 +7071,11 @@ char **methodName = &givenMethod; TclCallFrame *framePtr; - if (!csc) { - csc = CallStackGetTopFrame(interp, &framePtr); + if (!cscPtr) { + cscPtr = CallStackGetTopFrame(interp, &framePtr); } else { /* - * csc was given (i.e. it is not yet on the stack. So we cannot + * cscPtr was given (i.e. it is not yet on the stack. So we cannot * get objc from the associated stack frame */ framePtr = NULL; @@ -7083,12 +7084,17 @@ } /*fprintf(stderr, "XOTclNextMethod givenMethod = %s, csc = %p, useCallstackObj %d, objc %d cfp %p\n", - givenMethod, csc, useCallstackObjs, objc, framePtr);*/ + givenMethod, cscPtr, useCallstackObjs, objc, framePtr);*/ /* if no args are given => use args from stack */ if (objc < 2 && useCallstackObjs && framePtr) { - nobjc = Tcl_CallFrame_objc(framePtr); - nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(framePtr); + if (cscPtr->objv) { + nobjv = cscPtr->objv; + nobjc = cscPtr->objc; + } else { + nobjc = Tcl_CallFrame_objc(framePtr); + nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(framePtr); + } } else { nobjc = objc; nobjv = (Tcl_Obj **)objv; @@ -7107,7 +7113,7 @@ /* * Search the next method & compute its method data */ - result = NextSearchMethod(obj, interp, csc, cl, methodName, &cmd, + result = NextSearchMethod(obj, interp, cscPtr, cl, methodName, &cmd, &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); if (result != TCL_OK) { return result; @@ -7132,8 +7138,8 @@ * change mixin state */ if (obj->mixinStack) { - if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_MIXIN) - csc->frameType = XOTCL_CSC_TYPE_INACTIVE_MIXIN; + if (cscPtr->frameType == XOTCL_CSC_TYPE_ACTIVE_MIXIN) + cscPtr->frameType = XOTCL_CSC_TYPE_INACTIVE_MIXIN; /* otherwise move the command pointer forward */ if (isMixinEntry) { @@ -7145,9 +7151,9 @@ * change filter state */ if (obj->filterStack) { - if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { + if (cscPtr->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { /*fprintf(stderr, "next changes filter state\n");*/ - csc->frameType = XOTCL_CSC_TYPE_INACTIVE_FILTER; + cscPtr->frameType = XOTCL_CSC_TYPE_INACTIVE_FILTER; } /* otherwise move the command pointer forward */ @@ -7168,16 +7174,16 @@ if (nobjv1[0] == '-' && !strcmp(nobjv1, "--noArgs")) nobjc = 1; } - csc->callType |= XOTCL_CSC_CALL_IS_NEXT; + cscPtr->callType |= XOTCL_CSC_CALL_IS_NEXT; RUNTIME_STATE(interp)->unknown = 0; result = MethodDispatch((ClientData)obj, interp, nobjc, nobjv, cmd, - obj, *cl, *methodName, frameType); - csc->callType &= ~XOTCL_CSC_CALL_IS_NEXT; + obj, *cl, *methodName, frameType); + cscPtr->callType &= ~XOTCL_CSC_CALL_IS_NEXT; - if (csc->frameType == XOTCL_CSC_TYPE_INACTIVE_FILTER) - csc->frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; - else if (csc->frameType == XOTCL_CSC_TYPE_INACTIVE_MIXIN) - csc->frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; + if (cscPtr->frameType == XOTCL_CSC_TYPE_INACTIVE_FILTER) + cscPtr->frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; + else if (cscPtr->frameType == XOTCL_CSC_TYPE_INACTIVE_MIXIN) + cscPtr->frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; } else if (result == TCL_OK && endOfFilterChain) { /*fprintf(stderr, "setting unknown to 1\n");*/ RUNTIME_STATE(interp)->unknown = 1; @@ -7192,16 +7198,16 @@ int XOTclNextObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclCallStackContent *csc = CallStackGetTopFrame(interp, NULL); + XOTclCallStackContent *cscPtr = CallStackGetTopFrame(interp, NULL); - if (!csc) + if (!cscPtr) return XOTclVarErrMsg(interp, "next: can't find self", (char *) NULL); - if (!csc->cmdPtr) + if (!cscPtr->cmdPtr) return XOTclErrMsg(interp, "next: no executing proc", TCL_STATIC); - return XOTclNextMethod(csc->self, interp, csc->cl, - (char *)Tcl_GetCommandName(interp, csc->cmdPtr), + return XOTclNextMethod(cscPtr->self, interp, cscPtr->cl, + (char *)Tcl_GetCommandName(interp, cscPtr->cmdPtr), objc, objv, 1, NULL); } @@ -7212,22 +7218,22 @@ static int FindSelfNext(Tcl_Interp *interp, XOTclObject *obj) { - XOTclCallStackContent *csc = CallStackGetTopFrame(interp, NULL); + XOTclCallStackContent *cscPtr = CallStackGetTopFrame(interp, NULL); Tcl_Command cmd, currentCmd = 0; int result, isMixinEntry = 0, isFilterEntry = 0, endOfFilterChain = 0; - XOTclClass *cl = csc->cl; - XOTclObject *o = csc->self; + XOTclClass *cl = cscPtr->cl; + XOTclObject *o = cscPtr->self; char *methodName; Tcl_ResetResult(interp); - methodName = (char *)Tcl_GetCommandName(interp, csc->cmdPtr); + methodName = (char *)Tcl_GetCommandName(interp, cscPtr->cmdPtr); if (!methodName) return TCL_OK; - result = NextSearchMethod(o, interp, csc, &cl, &methodName, &cmd, + result = NextSearchMethod(o, interp, cscPtr, &cl, &methodName, &cmd, &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); if (cmd) { @@ -8876,8 +8882,8 @@ #if defined(TCL85STACK) /* no need to store varFramePtr in call frame for tcl85stack */ #else - XOTclCallStackContent *csc = CallStackGetTopFrame(interp, NULL); - csc->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); + XOTclCallStackContent *cscPtr = CallStackGetTopFrame(interp, NULL); + cscPtr->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); /*fprintf(stderr, "...setting currentFramePtr %p to %p (ForwardMethod)\n", RUNTIME_STATE(interp)->cs.top->currentFramePtr, (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp)); @@ -9958,6 +9964,7 @@ case InfomethodsubcmdDefinitionIdx: { ClientData clientData = cmd ? Tcl_Command_objClientData(cmd) : NULL; + if (clientData) { resultObj = Tcl_NewListObj(0, NULL); /* todo: don't hard-code registering command name "forward" */ @@ -9994,6 +10001,7 @@ case InfomethodsubcmdDefinitionIdx: { Tcl_Obj *entryObj = AliasGet(interp, object->cmdName, methodName, withPer_object); + if (entryObj) { int nrElements; Tcl_Obj **listElements; @@ -11798,7 +11806,7 @@ */ static int XOTclGetSelfObjCmd(Tcl_Interp *interp, int selfoption) { XOTclObject *obj = GetSelfObj(interp); - XOTclCallStackContent *csc; + XOTclCallStackContent *cscPtr; int result = TCL_OK; /*fprintf(stderr, "getSelfObj returns %p\n", obj); tcl85showStack(interp);*/ @@ -11818,9 +11826,9 @@ switch (selfoption) { case SelfoptionProcIdx: { /* proc subcommand */ - csc = CallStackGetTopFrame(interp, NULL); - if (csc) { - CONST char *procName = Tcl_GetCommandName(interp, csc->cmdPtr); + cscPtr = CallStackGetTopFrame(interp, NULL); + if (cscPtr) { + CONST char *procName = Tcl_GetCommandName(interp, cscPtr->cmdPtr); Tcl_SetResult(interp, (char *)procName, TCL_VOLATILE); } else { return XOTclVarErrMsg(interp, "Can't find proc", (char *) NULL); @@ -11829,8 +11837,8 @@ } case SelfoptionClassIdx: { /* class subcommand */ - csc = CallStackGetTopFrame(interp, NULL); - Tcl_SetObjResult(interp, csc->cl ? csc->cl->object.cmdName : XOTclGlobalObjects[XOTE_EMPTY]); + cscPtr = CallStackGetTopFrame(interp, NULL); + Tcl_SetObjResult(interp, cscPtr->cl ? cscPtr->cl->object.cmdName : XOTclGlobalObjects[XOTE_EMPTY]); break; } @@ -11844,9 +11852,14 @@ Tcl_Obj **nobjv; Tcl_CallFrame *topFramePtr; - CallStackGetTopFrame(interp, &topFramePtr); - nobjc = Tcl_CallFrame_objc(topFramePtr); - nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(topFramePtr); + cscPtr = CallStackGetTopFrame(interp, &topFramePtr); + if (cscPtr->objv) { + nobjc = cscPtr->objc; + nobjv = cscPtr->objv; + } else { + nobjc = Tcl_CallFrame_objc(topFramePtr); + nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(topFramePtr); + } Tcl_SetObjResult(interp, Tcl_NewListObj(nobjc-1, nobjv+1)); break; } @@ -11862,9 +11875,9 @@ case SelfoptionCalledprocIdx: case SelfoptionCalledmethodIdx: { - csc = CallStackFindActiveFilter(interp); - if (csc) { - Tcl_SetObjResult(interp, csc->filterStackEntry->calledProc); + cscPtr = CallStackFindActiveFilter(interp); + if (cscPtr) { + Tcl_SetObjResult(interp, cscPtr->filterStackEntry->calledProc); } else { result = XOTclVarErrMsg(interp, "called from outside of a filter", (char *) NULL); @@ -11877,14 +11890,14 @@ break; case SelfoptionCallingprocIdx: - csc = XOTclCallStackFindLastInvocation(interp, 1, NULL); - Tcl_SetResult(interp, csc ? (char *)Tcl_GetCommandName(interp, csc->cmdPtr) : "", + cscPtr = XOTclCallStackFindLastInvocation(interp, 1, NULL); + Tcl_SetResult(interp, cscPtr ? (char *)Tcl_GetCommandName(interp, cscPtr->cmdPtr) : "", TCL_VOLATILE); break; case SelfoptionCallingclassIdx: - csc = XOTclCallStackFindLastInvocation(interp, 1, NULL); - Tcl_SetObjResult(interp, csc && csc->cl ? csc->cl->object.cmdName : + cscPtr = XOTclCallStackFindLastInvocation(interp, 1, NULL); + Tcl_SetObjResult(interp, cscPtr && cscPtr->cl ? cscPtr->cl->object.cmdName : XOTclGlobalObjects[XOTE_EMPTY]); break; @@ -11897,14 +11910,14 @@ break; case SelfoptionCallingobjectIdx: - csc = XOTclCallStackFindLastInvocation(interp, 1, NULL); - Tcl_SetObjResult(interp, csc ? csc->self->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); + cscPtr = XOTclCallStackFindLastInvocation(interp, 1, NULL); + Tcl_SetObjResult(interp, cscPtr ? cscPtr->self->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); break; case SelfoptionFilterregIdx: - csc = CallStackFindActiveFilter(interp); - if (csc) { - Tcl_SetObjResult(interp, FilterFindReg(interp, obj, csc->cmdPtr)); + cscPtr = CallStackFindActiveFilter(interp); + if (cscPtr) { + Tcl_SetObjResult(interp, FilterFindReg(interp, obj, cscPtr->cmdPtr)); } else { result = XOTclVarErrMsg(interp, "self filterreg called from outside of a filter", @@ -11914,17 +11927,17 @@ case SelfoptionIsnextcallIdx: { Tcl_CallFrame *framePtr; - csc = CallStackGetTopFrame(interp, &framePtr); + cscPtr = CallStackGetTopFrame(interp, &framePtr); #if defined(TCL85STACK) framePtr = nextFrameOfType(Tcl_CallFrame_callerPtr(framePtr), FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD); - csc = framePtr ? Tcl_CallFrame_clientData(framePtr) : NULL; + cscPtr = framePtr ? Tcl_CallFrame_clientData(framePtr) : NULL; #else - csc--; - if (csc <= RUNTIME_STATE(interp)->cs.content) - csc = NULL; + cscPtr--; + if (cscPtr <= RUNTIME_STATE(interp)->cs.content) + cscPtr = NULL; #endif Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (csc && (csc->callType & XOTCL_CSC_CALL_IS_NEXT))); + (cscPtr && (cscPtr->callType & XOTCL_CSC_CALL_IS_NEXT))); break; } @@ -12374,14 +12387,14 @@ /* method for calling e.g. $obj __next */ static int XOTclONextMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { - XOTclCallStackContent *csc = CallStackGetObjectFrame(interp, obj); + XOTclCallStackContent *cscPtr = CallStackGetObjectFrame(interp, obj); char *methodName; - if (!csc) + if (!cscPtr) return XOTclVarErrMsg(interp, "__next: can't find object", objectName(obj), (char *) NULL); - methodName = (char *)Tcl_GetCommandName(interp, csc->cmdPtr); - return XOTclNextMethod(obj, interp, csc->cl, methodName, objc-1, &objv[1], 0, NULL); + methodName = (char *)Tcl_GetCommandName(interp, cscPtr->cmdPtr); + return XOTclNextMethod(obj, interp, cscPtr->cl, methodName, objc-1, &objv[1], 0, NULL); } static int XOTclONoinitMethod(Tcl_Interp *interp, XOTclObject *obj) { @@ -13048,8 +13061,8 @@ XOTclObject *pobj = pcl ? &pcl->object : object; int perObject = (pcl == NULL); ListMethod(interp, pobj, pattern, cmd, InfomethodsubcmdDefinitionIdx, perObject); - return TCL_OK; } + return TCL_OK; } return ListCallableMethods(interp, object, pattern, 1 /* per-object */, @@ -13483,9 +13496,9 @@ int XOTclInterpretNonpositionalArgsCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclCallStackContent *csc = CallStackGetFrame(interp, NULL); - XOTclParamDefs *paramDefs = ParamDefsGet(csc->cmdPtr); - char *procName = (char *)Tcl_GetCommandName(interp, csc->cmdPtr); + XOTclCallStackContent *cscPtr = CallStackGetFrame(interp, NULL); + XOTclParamDefs *paramDefs = ParamDefsGet(cscPtr->cmdPtr); + char *procName = (char *)Tcl_GetCommandName(interp, cscPtr->cmdPtr); Tcl_Obj *proc = Tcl_NewStringObj(procName, -1); XOTclParam CONST *pPtr; parseContext pc; @@ -13498,7 +13511,7 @@ /*if (!paramDefs) {return TCL_OK;}*/ INCR_REF_COUNT(proc); - result = ArgumentParse(interp, objc, objv, csc->self, proc, paramDefs->paramsPtr, objc, &pc); + result = ArgumentParse(interp, objc, objv, cscPtr->self, proc, paramDefs->paramsPtr, objc, &pc); DECR_REF_COUNT(proc); if (result != TCL_OK) { Index: generic/xotclInt.h =================================================================== diff -u -rf6775105babd749f662856c7eff1a903636e80e0 -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 --- generic/xotclInt.h (.../xotclInt.h) (revision f6775105babd749f662856c7eff1a903636e80e0) +++ generic/xotclInt.h (.../xotclInt.h) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02) @@ -556,9 +556,11 @@ #if !defined(TCL85STACK) Tcl_CallFrame *currentFramePtr; #endif + XOTclFilterStack *filterStackEntry; + Tcl_Obj ** objv; + int objc; unsigned short frameType; unsigned short callType; - XOTclFilterStack *filterStackEntry; } XOTclCallStackContent; #define XOTCL_CSC_TYPE_PLAIN 0 Index: generic/xotclStack85.c =================================================================== diff -u -rcefa8e6f9be67238cc954372506d39d84b80e179 -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 --- generic/xotclStack85.c (.../xotclStack85.c) (revision cefa8e6f9be67238cc954372506d39d84b80e179) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02) @@ -412,6 +412,7 @@ csc->frameType = frameType; csc->callType = 0; csc->filterStackEntry = frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER ? obj->filterStack : NULL; + csc->objv = NULL; #if defined(TCL85STACK_TRACE) fprintf(stderr, "PUSH csc %p type %d obj %s, self=%p cmd=%p (%s) id=%p (%s) obj refcount %d name refcount %d\n", Index: tests/method-modifiers.xotcl =================================================================== diff -u -r73eb4eccd33d1a940e2d2ca6dccc2f74216f0576 -r99b9e9e9c78df12e482d16bca08ffeb5998b3b02 --- tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 73eb4eccd33d1a940e2d2ca6dccc2f74216f0576) +++ tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 99b9e9e9c78df12e482d16bca08ffeb5998b3b02) @@ -70,26 +70,29 @@ # create a fresh object (different from c1) C create c2 - # test scripted class level methods +Test case scripted-class-level-methods ? {c2 plain_method} "plain_method" ? {c2 public_method} "public_method" ? {catch {c2 protected_method}} 1 ? {::xotcl::dispatch c2 protected_method} "protected_method" # class level forwards +Test case class-level-forwards ? {c2 plain_forward} "plain_method" ? {c2 public_forward} "public_method" ? {catch {c2 protected_forward}} 1 ? {::xotcl::dispatch c2 protected_forward} "protected_method" # class level setter +Test case class-level-setter ? {c2 plain_setter 1} "1" ? {c2 public_setter 2} "2" ? {catch {c2 protected_setter 3}} 1 ? {::xotcl::dispatch c2 protected_setter 4} "4" # class level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +Test case class-level-alias ? {c2 plain_alias} "plain_method" ? {c2 public_alias} "public_method" ? {catch {c2 protected_alias}} 1 @@ -98,24 +101,28 @@ ########### # scripted class-object level methods +Test case scripted-class-object-level ? {C plain_object_method} "plain_object_method" ? {C public_object_method} "public_object_method" ? {catch {C protected_object_method}} 1 ? {::xotcl::dispatch C protected_object_method} "protected_object_method" # class-object level forwards +Test case class-object-level-forwards ? {C plain_object_forward} "plain_object_method" ? {C public_object_forward} "public_object_method" ? {catch {C protected_object_forward}} 1 ? {::xotcl::dispatch C protected_object_forward} "protected_object_method" # class-object level setter +Test case class-object-level-setter ? {C plain_object_setter 1} "1" ? {C public_object_setter 2} "2" ? {catch {C protected_object_setter 3}} 1 ? {::xotcl::dispatch C protected_object_setter 4} "4" # class-object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +Test case class-object-level-alias ? {C plain_object_alias} "plain_object_method" ? {C public_object_alias} "public_object_method" ? {catch {C protected_object_alias}} 1 @@ -124,24 +131,28 @@ ########### # scripted object level methods +Test case scripted-object-level-methods ? {c1 plain_object_method} "plain_object_method" ? {c1 public_object_method} "public_object_method" ? {catch {c1 protected_object_method}} 1 ? {::xotcl::dispatch c1 protected_object_method} "protected_object_method" # object level forwards +Test case object-level-forwards ? {c1 plain_object_forward} "plain_object_method" ? {c1 public_object_forward} "public_object_method" ? {catch {c1 protected_object_forward}} 1 ? {::xotcl::dispatch c1 protected_object_forward} "protected_object_method" # object level setter +Test case object-level-setter ? {c1 plain_object_setter 1} "1" ? {c1 public_object_setter 2} "2" ? {catch {c1 protected_object_setter 3}} 1 ? {::xotcl::dispatch c1 protected_object_setter 4} "4" # object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +Test case object-level-alias ? {c1 plain_object_alias} "plain_object_method" ? {c1 public_object_alias} "public_object_method" ? {catch {c1 protected_object_alias}} 1 @@ -157,6 +168,7 @@ Class create C Class create M +Test case mixinguards # define a Class C and mixin class M Class create C Class create M @@ -175,7 +187,7 @@ C object mixinguard M {} ? {C object info mixinguard M} "" - +Test case mixin-via-objectparam # add an object and class mixin via object-parameter and via slots Class create M1; Class create M2; Class create M3; Class create M4 Class create C -mixin M1 -object-mixin M2 { @@ -184,4 +196,28 @@ } ? {lsort [C object info mixin]} "::M2 ::M4" -? {lsort [C info mixin]} "::M1 ::M3" \ No newline at end of file +? {lsort [C info mixin]} "::M1 ::M3" +C destroy +M1 destroy; M2 destroy; M3 destroy; M4 destroy; + +# testing next via nonpos-args +Test case next-from-nonpos-args + +Object create o { + .method bar {-y:required -x:required} { + #puts stderr "+++ o x=$x, y=$y [self args] ... next [self next]" + return [list x $x y $y [self args]] + } +} +Class create M { + .method bar {-x:required -y:required} { + #puts stderr "+++ M x=$x, y=$y [self args] ... next [self next]" + return [list x $x y $y [self args] -- {*}[next]] + } +} + +o mixin M +puts stderr ===== +? {o bar -x 13 -y 14} "x 13 y 14 {-x 13 -y 14} -- x 13 y 14 {-x 13 -y 14}" +puts stderr ===== +? {o bar -y 14 -x 13} "x 13 y 14 {-y 14 -x 13} -- x 13 y 14 {-y 14 -x 13}" \ No newline at end of file