Index: TODO =================================================================== diff -u -r1e3a84fd851f93ae3116130a530fae5e8bd63336 -r693aa83247d37e11744c0a442ec10b22d218db9f --- TODO (.../TODO) (revision 1e3a84fd851f93ae3116130a530fae5e8bd63336) +++ TODO (.../TODO) (revision 693aa83247d37e11744c0a442ec10b22d218db9f) @@ -1327,9 +1327,16 @@ (and accordingly c definitions, migration guide) - pass tclobj instead of string to NsfObjInfoMethodMethod and NsfObjInfoMethodsMethod -- first part of ensemble name resolver +- first part of ensemble name resolver. We can resolve now e.g. + [nx::Object info method parameter "info lookup methods"] +- second part of ensemble name resolver, distinguish between + registration object and definition object +- new functions: GetRegObject() +- extended regression test TODO: +- /* TODO: what, if we call on a class "info method" with a methodhandle of an object? */ +- check potential crashes with invalid input - check equivalence of the following two commands in respect to fully-qualified names Index: generic/nsf.c =================================================================== diff -u -r1e3a84fd851f93ae3116130a530fae5e8bd63336 -r693aa83247d37e11744c0a442ec10b22d218db9f --- generic/nsf.c (.../nsf.c) (revision 1e3a84fd851f93ae3116130a530fae5e8bd63336) +++ generic/nsf.c (.../nsf.c) (revision 693aa83247d37e11744c0a442ec10b22d218db9f) @@ -510,7 +510,7 @@ } NSF_INLINE static int -IsClassName(CONST char *string) { +IsClassNsName(CONST char *string) { return (strncmp((string), "::nsf::classes", 14) == 0); } @@ -527,7 +527,7 @@ * Get object or class from a fully qualified cmd name, such as * e.g. ::nsf::classes::X */ - if (IsClassName(string)) { + if (IsClassNsName(string)) { *fromClassNS = 1; return (NsfObject *)GetClassFromString(interp, NSCutNsfClasses(string)); } else { @@ -1114,24 +1114,68 @@ *---------------------------------------------------------------------- */ static NsfObject * -GetEnsembeObjectFromName(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *name) { - NsfObject *object; +GetEnsembeObjectFromName(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *name, + Tcl_Command *cmdPtr, int *fromClassNS) { Tcl_Command cmd; char *nameString = ObjStr(name); if (*nameString == ':') { cmd = Tcl_GetCommandFromObj(interp, name); + *fromClassNS = IsClassNsName(nameString); } else { cmd = FindMethod(nsPtr, nameString); } - object = cmd ? NsfGetObjectFromCmdPtr(cmd) : NULL; - /*fprintf(stderr, "GetEnsembeObjectFromName returns %p\n", object);*/ - return object; + if (cmd) { + *cmdPtr = cmd; + return NsfGetObjectFromCmdPtr(cmd); + } + return NULL; } /* *---------------------------------------------------------------------- + * GetRegObject -- + * + * Try to get the object, on which the method was registered from a + * folly qaulified method handle + * + * Results: + * NsfObject * or NULL on failure + * + * Side effects: + * none + * + *---------------------------------------------------------------------- + */ +NsfObject * +GetRegObject(Tcl_Interp *interp, Tcl_Command cmd, CONST char *methodName, + CONST char **methodName1, int *fromClassNS) { + NsfObject *regObject = NULL; + + if (cmd && *methodName == ':') { + CONST char *procName = Tcl_GetCommandName(interp, cmd); + size_t objNameLength = strlen(methodName) - strlen(procName) - 2; + Tcl_DString ds, *dsPtr = &ds; + + if (objNameLength > 0) { + Tcl_DStringInit(dsPtr); + Tcl_DStringAppend(dsPtr, methodName, objNameLength); + regObject = GetObjectFromNsName(interp, Tcl_DStringValue(dsPtr), fromClassNS); + /*fprintf(stderr, "GetRegObject %s -> %p\n", Tcl_DStringValue(dsPtr), regObject);*/ + if (regObject) { + *methodName1 = procName; + } + Tcl_DStringFree(dsPtr); + } + } + + /*fprintf(stderr, "GetRegObject cmd %p methodName '%s' => %p\n", cmd, methodName, regObject);*/ + return regObject; +} + +/* + *---------------------------------------------------------------------- * ResolveMethodName -- * * Resolve a method name relative to a provided namespace. @@ -1150,39 +1194,91 @@ */ static Tcl_Command -ResolveMethodName(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *methodObj) { +ResolveMethodName(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *methodObj, + Tcl_DString *methodNameDs, + NsfObject **regObject, + NsfObject **defObject, + CONST char **methodName1, int *fromClassNS) { Tcl_Command cmd; + NsfObject *referencedObject; char* methodName = ObjStr(methodObj); - + if (nsPtr && strchr(methodName, ' ') > 0) { Tcl_Obj *methodHandleObj; - NsfObject *referencedObject; Tcl_Obj **ov; - int oc=0, result, i; + int oc, result, i; /*fprintf(stderr, "name '%s' contains space \n", methodName);*/ + if ((result = Tcl_ListObjGetElements(interp, methodObj, &oc, &ov) != TCL_OK) - || ((referencedObject = GetEnsembeObjectFromName(interp, nsPtr, ov[0])) == NULL) + || ((referencedObject = GetEnsembeObjectFromName(interp, nsPtr, ov[0], + &cmd, fromClassNS)) == NULL) ) { + *methodName1 = NULL; + *regObject = NULL; + *defObject = NULL; return NULL; } - /*fprintf(stderr, "... referenced object '%s' \n", objectName(referencedObject));*/ + + /* + * We have an ensemble object. First, figure out, on which + * object/class the ensemble object was registered. We determine + * the regObject on the first element of the list. If we can't, + * then the current object is the regObject. + */ + *regObject = GetRegObject(interp, cmd, ObjStr(ov[0]), methodName1, fromClassNS); + + /*fprintf(stderr, "... referenced object '%s' reg %p\n", + objectName(referencedObject), *regObject);*/ + + /* + * Build a fresh methodHandleObj to held method name and names of + * subcmds. + */ methodHandleObj = Tcl_DuplicateObj(referencedObject->cmdName); + Tcl_DStringAppend(methodNameDs, Tcl_GetCommandName(interp, cmd), -1); + /* + * Iterate over the objects and append to the handle and methodObj + */ for (i = 1; i 0) { - NsfObject *object1; - int fromClassNS; - - Tcl_DStringInit(dsPtr); - Tcl_DStringAppend(dsPtr, methodName, objNameLength); - object1 = GetObjectFromNsName(interp, Tcl_DStringValue(dsPtr), &fromClassNS); - if (object1) { - /* - * The command was from an object, return therefore this - * object as reference. - */ - /*fprintf(stderr, "We are flipping the object to %s, method %s to %s !fromClassNS %d\n", - objectName(object1), methodName, procName, !fromClassNS);*/ - object = object1; - methodName = procName; - withPer_object = fromClassNS ? 0 : 1; - } - Tcl_DStringFree(dsPtr); - } - } - - if (!NsfObjectIsClass(object)) { + if (!NsfObjectIsClass(regObject)) { withPer_object = 1; - /* don't output "object" modifier, if object is not a class */ + /* don't output "object" modifier, if regObject is not a class */ outputPerObject = 0; } else { outputPerObject = withPer_object; @@ -10531,7 +10601,7 @@ switch (subcmd) { case InfomethodsubcmdHandleIdx: { - return ListMethodHandle(interp, object, withPer_object, methodName); + return ListMethodHandle(interp, regObject, withPer_object, methodName); } case InfomethodsubcmdArgsIdx: { @@ -10552,9 +10622,9 @@ { NsfProcAssertion *procs; if (withPer_object) { - procs = object->opt ? AssertionFindProcs(object->opt->assertions, methodName) : NULL; + procs = regObject->opt ? AssertionFindProcs(regObject->opt->assertions, methodName) : NULL; } else { - NsfClass *class = (NsfClass *)object; + NsfClass *class = (NsfClass *)regObject; procs = class->opt ? AssertionFindProcs(class->opt->assertions, methodName) : NULL; } if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->pre)); @@ -10564,9 +10634,9 @@ { NsfProcAssertion *procs; if (withPer_object) { - procs = object->opt ? AssertionFindProcs(object->opt->assertions, methodName) : NULL; + procs = regObject->opt ? AssertionFindProcs(regObject->opt->assertions, methodName) : NULL; } else { - NsfClass *class = (NsfClass *)object; + NsfClass *class = (NsfClass *)regObject; procs = class->opt ? AssertionFindProcs(class->opt->assertions, methodName) : NULL; } if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); @@ -10600,16 +10670,16 @@ resultObj = Tcl_NewListObj(0, NULL); /* todo: don't hard-code registering command name "method" / NSF_METHOD */ AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_METHOD], - object, methodName, cmd, 0, outputPerObject); + regObject, methodName, cmd, 0, outputPerObject); ListCmdParams(interp, cmd, methodName, 0); Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp)); ListProcBody(interp, GetTclProcFromCommand(cmd), methodName); Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp)); if (withPer_object) { - assertions = object->opt ? object->opt->assertions : NULL; + assertions = regObject->opt ? regObject->opt->assertions : NULL; } else { - NsfClass *class = (NsfClass *)object; + NsfClass *class = (NsfClass *)regObject; assertions = class->opt ? class->opt->assertions : NULL; } if (assertions) { @@ -10640,7 +10710,7 @@ resultObj = Tcl_NewListObj(0, NULL); /* todo: don't hard-code registering command name "forward" / NSF_FORWARD*/ AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_FORWARD], - object, methodName, cmd, 0, outputPerObject); + regObject, methodName, cmd, 0, outputPerObject); AppendForwardDefinition(interp, resultObj, clientData); Tcl_SetObjResult(interp, resultObj); break; @@ -10660,7 +10730,7 @@ resultObj = Tcl_NewListObj(0, NULL); /* todo: don't hard-code registering command name "setter" / NSF_SETTER */ - AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_SETTER], object, + AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_SETTER], regObject, cd->paramsPtr ? ObjStr(cd->paramsPtr->paramObj) : methodName, cmd, 0, outputPerObject); Tcl_SetObjResult(interp, resultObj); @@ -10677,10 +10747,19 @@ * really an alias. */ - Tcl_Obj *entryObj = AliasGet(interp, object->cmdName, methodName, withPer_object); - /*fprintf(stderr, "aliasGet %s -> %s (%d) returned %p\n", - objectName(object), methodName, withPer_object, entryObj);*/ + Tcl_Obj *entryObj; + entryObj = AliasGet(interp, defObject->cmdName, + Tcl_GetCommandName(interp, cmd), + regObject != defObject ? 1 : withPer_object); + /* + fprintf(stderr, "aliasGet %s -> %s/%s (%d) returned %p\n", + objectName(defObject), methodName, Tcl_GetCommandName(interp, cmd), + withPer_object, entryObj); + fprintf(stderr, "... regObject %p %s\n",regObject,objectName(regObject)); + fprintf(stderr, "... defObject %p %s\n",defObject,objectName(defObject)); + */ + if (entryObj) { /* is an alias */ switch (subcmd) { @@ -10695,7 +10774,7 @@ Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements); /* todo: don't hard-code registering command name "alias" / NSF_ALIAS */ AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_ALIAS], - object, methodName, cmd, nrElements!=1, outputPerObject); + regObject, methodName, cmd, nrElements!=1, outputPerObject); Tcl_ListObjAppendElement(interp, resultObj, listElements[nrElements-1]); Tcl_SetObjResult(interp, resultObj); break; @@ -10734,7 +10813,9 @@ } else { /* should never happen */ fprintf(stderr, "should never happen, maybe someone deleted the alias %s for object %s\n", - methodName, objectName(object)); + methodName, objectName(regObject)); + fprintf(stderr, "procPtr %p NsfObjDispatch %p name %s \n", + procPtr, NsfObjDispatch, Tcl_GetCommandName(interp, cmd)); Tcl_ResetResult(interp); } } @@ -11034,7 +11115,7 @@ Tcl_Obj *obj = Tcl_GetVar2Ex(interp, NsfGlobalStrings[NSF_ALIAS_ARRAY], AliasIndex(dsPtr, cmdName, methodName, withPer_object), TCL_GLOBAL_ONLY); - /*fprintf(stderr, "aliasGet returns %p\n", object);*/ + /*fprintf(stderr, "aliasGet methodName '%s' returns %p\n", methodName, obj);*/ Tcl_DStringFree(dsPtr); return obj; } @@ -14318,7 +14399,7 @@ NsfObject *pobj = pcl ? &pcl->object : object; int perObject = (pcl == NULL); - ListMethod(interp, pobj, name, cmd, InfomethodsubcmdHandleIdx, perObject); + ListMethod(interp, pobj, pobj, name, cmd, InfomethodsubcmdHandleIdx, perObject); } return TCL_OK; } @@ -14432,11 +14513,23 @@ static int NsfObjInfoMethodMethod(Tcl_Interp *interp, NsfObject *object, - int subcmd, Tcl_Obj *methodName) { + int subcmd, Tcl_Obj *methodNameObj) { + NsfObject *regObject, *defObject; + CONST char *methodName1 = NULL; + int fromClassNS = 0, result; + Tcl_DString ds, *dsPtr = &ds; + Tcl_Command cmd; - return ListMethod(interp, object, ObjStr(methodName), - ResolveMethodName(interp, object->nsPtr, methodName), - subcmd, 1); + Tcl_DStringInit(dsPtr); + cmd = ResolveMethodName(interp, object->nsPtr, methodNameObj, + dsPtr, ®Object, &defObject, &methodName1, &fromClassNS); + result = ListMethod(interp, + regObject ? regObject : object, + defObject ? defObject : object, + methodName1, cmd, subcmd, fromClassNS ? 0 : 1); + Tcl_DStringFree(dsPtr); + + return result; } /* @@ -14664,11 +14757,25 @@ static int NsfClassInfoMethodMethod(Tcl_Interp *interp, NsfClass *class, - int subcmd, Tcl_Obj *methodName) { + int subcmd, Tcl_Obj *methodNameObj) { + NsfObject *regObject, *defObject; + CONST char *methodName1 = NULL; + int fromClassNs = 0, result; + Tcl_DString ds, *dsPtr = &ds; + Tcl_Command cmd; - return ListMethod(interp, &class->object, ObjStr(methodName), - ResolveMethodName(interp, class->nsPtr, methodName), - subcmd, 0); + Tcl_DStringInit(dsPtr); + cmd = ResolveMethodName(interp, class->nsPtr, methodNameObj, + dsPtr, ®Object, &defObject, &methodName1, &fromClassNs); + /* TODO: what, if we call on a class "info method" with a methodhandle of an object? */ + result = ListMethod(interp, + regObject ? regObject : &class->object, + defObject ? defObject : &class->object, + methodName1, + cmd, subcmd, 0); + Tcl_DStringFree(dsPtr); + + return result; } /* Index: tests/info-method.tcl =================================================================== diff -u -r27e11788125901ff468955117d165f70d3871ce0 -r693aa83247d37e11744c0a442ec10b22d218db9f --- tests/info-method.tcl (.../info-method.tcl) (revision 27e11788125901ff468955117d165f70d3871ce0) +++ tests/info-method.tcl (.../info-method.tcl) (revision 693aa83247d37e11744c0a442ec10b22d218db9f) @@ -194,4 +194,70 @@ ? {D info lookup slots} "::nx::Class::slot::object-mixin ::nx::Class::slot::mixin ::nx::Class::slot::superclass ::nx::Class::slot::object-filter ::nx::Class::slot::filter ::nx::Object::slot::class" ? {D info slots} "::D::slot::b ::D::slot::a2 ::D::slot::c" ? {::nx::Object info method parameter info} "" -} \ No newline at end of file +} + + +Test case info-submethod { + + nx::Object create o { + :method "foo a" {} {return a} + :method "foo b" {x:int y:upper} {return b} + } + + nx::Class create C { + :method "bar a" {} {return a} + :method "bar b" {x:int y:upper} {return b} + :method "bar baz x" {x:int y:upper} {return x} + :method "bar baz y" {x:int y:upper} {return y} + } + + # query defintion on of subcommand + ? {o info method definition "foo b"} {::o method {foo b} {x:int y:upper} {return b}} + + # query defintion on of subcommand on handle + ? {o info method definition "::o::foo b"} {::o method {foo b} {x:int y:upper} {return b}} + + # query defintion on ensemble object + ? {o info method definition "::o::foo::b"} {::o::foo method b {x:int y:upper} {return b}} + + # query definition of subcommand of class + ? {::nx::Object info method definition "info lookup methods"} \ + {::nx::Object alias {info lookup methods} ::nsf::cmd::ObjectInfo::lookupmethods} + + # query definition of subcommand of class on handle + ? {o info method definition "::nsf::classes::nx::Object::info lookup methods"} \ + {::nx::Object alias {info lookup methods} ::nsf::cmd::ObjectInfo::lookupmethods} + + # query definition on ensemble object of class + ? {o info method definition "::nx::Object::slot::__info::lookup::methods"} \ + {::nx::Object::slot::__info::lookup alias methods ::nsf::cmd::ObjectInfo::lookupmethods} + + + ? {C info method handle "bar"} {::nsf::classes::C::bar} + ? {C info method handle "bar a"} {::nsf::classes::C::bar a} + ? {C info method handle "bar baz y"} {::nsf::classes::C::bar baz y} + + ? {C info method definition "bar baz y"} \ + {::C method {bar baz y} {x:int y:upper} {return y}} + ? {C info method definition "::nsf::classes::C::bar baz y"} \ + {::C method {bar baz y} {x:int y:upper} {return y}} + + ? {nx::Object info method parameter "info lookup methods"} \ + "-methodtype -callprotection -application -nomixins -incontext pattern:optional" + ? {o info method parameter "foo b"} "x:int y:upper" + + ? {nx::Object info method parameter ::nx::Object::slot::__info::lookup::methods} \ + "-methodtype -callprotection -application -nomixins -incontext pattern:optional" + ? {o info method parameter "::o::foo::b"} "x:int y:upper" + + + ? {nx::Object info method handle "info"} "::nsf::classes::nx::Object::info" + + ? {nx::Object info method handle "info lookup methods"} \ + "::nsf::classes::nx::Object::info lookup methods" + + ? {nx::Object info method handle "::nsf::classes::nx::Object::info lookup methods"} \ + "::nsf::classes::nx::Object::info lookup methods" + + ? {o info method handle "foo b"} "::o::foo b" +} Index: tests/method-modifiers.tcl =================================================================== diff -u -re849d060161385466c782e46c19344428934cd7f -r693aa83247d37e11744c0a442ec10b22d218db9f --- tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision e849d060161385466c782e46c19344428934cd7f) +++ tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision 693aa83247d37e11744c0a442ec10b22d218db9f) @@ -242,10 +242,10 @@ :attribute {b b1} :public attribute {c c1} :protected attribute {d d1} - +#puts stderr ====== set X [:object attribute A] ? [list set _ $X] "::C::A" - +#exit # object attribute with default :object attribute {B B2} :public object attribute {C C2}