Index: generic/nsf.c =================================================================== diff -u -r344ce3ff14a5e73d80063af9c296a9a2261a7e1a -r40b842e5b218cc6144506ff4689671b780c4e8c5 --- generic/nsf.c (.../nsf.c) (revision 344ce3ff14a5e73d80063af9c296a9a2261a7e1a) +++ generic/nsf.c (.../nsf.c) (revision 40b842e5b218cc6144506ff4689671b780c4e8c5) @@ -15616,7 +15616,7 @@ /* fprintf(stderr, "cached scipted call %s (object %s class %s) cmd %p (proc %p) cmdName %s \n", methodName, ObjectName(object), ClassName(object->cl), ccCtxPtr->cmd, Tcl_Command_objClientData(ccCtxPtr->cmd), Tcl_GetCommandName(interp, ccCtxPtr->cmd));*/ - + Proc *procPtr = Tcl_Command_objClientData(ccCtxPtr->cmd); if ((Tcl_Interp *)procPtr->iPtr != interp @@ -26748,7 +26748,7 @@ for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSrch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSrch)) { - NsfObject *childObject; + NsfObject *childObject = NULL, *directObject = NULL; Tcl_Command origCmd; key = Tcl_GetHashKey(tablePtr, hPtr); @@ -26763,10 +26763,28 @@ * NULL. Below, we are just interested on true sub-objects. */ origCmd = GetOriginalCommand(cmd); - childObject = (isObject) ? NsfGetObjectFromCmdPtr(origCmd) : NULL; + if (isObject) { + childObject = NsfGetObjectFromCmdPtr(origCmd); + directObject = NsfGetObjectFromCmdPtr(cmd); + } + /*fprintf(stderr, "key <%s> isObject %d childObject %p directo %p ensemble %d prefixl %d ali %d ali2 %d hasChild %d\n", + key, isObject, (void*)childObject,(void*)directObject, + childObject ? ((childObject->flags & NSF_KEEP_CALLER_SELF) != 0u) : 0, + prefixLength, Tcl_Command_objProc(cmd) == NsfProcAliasMethod, + childObject ? AliasGet(interp, childObject->cmdName, key, withPer_object, NSF_FALSE) != NULL : 0, + childObject ? (childObject->nsPtr == NULL) : 0 + );*/ + if (childObject != NULL) { - if (withPath) { + /* + * If we have a child object, check if we have an ensemble method, + * which we detect on the flag NSF_KEEP_CALLER_SELF. + */ + if (withPath + && ((childObject->flags & NSF_KEEP_CALLER_SELF) != 0u) + && ((childObject->flags & NSF_PER_OBJECT_DISPATCH) != 0u) + ) { Tcl_HashTable *cmdTablePtr; if (childObject->nsPtr == NULL) { @@ -26796,7 +26814,7 @@ } /*fprintf(stderr, "ListMethodKeys key %s append key space flags %.6x\n", - key, childObject->flags);*/ + key, childObject->flags);*/ if (prefix == NULL) { Tcl_DString ds, *dsPtr = &ds; @@ -26817,6 +26835,35 @@ */ continue; } + + if ((childObject->flags & NSF_IS_SLOT_CONTAINER) != 0u) { + /* + * Don't report slot container. + */ + continue; + } + + if (withPath && directObject != 0u) { + /* + * Don't report direct children when "-path" was requested + */ + continue; + } + +#if 0 + if (!withPath && directObject != NULL) { + /* + * Don't report true child objects if no "-path" was requested, + * unless these are from ensemble methods. + */ + if (!( + ((childObject->flags & NSF_KEEP_CALLER_SELF) != 0u) + && ((childObject->flags & NSF_PER_OBJECT_DISPATCH) != 0u) + )) { + continue; + } + } +#endif } if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD) != 0u @@ -26829,6 +26876,7 @@ continue; } + if (prefixLength != 0) { Tcl_DStringAppend(prefix, key, -1); key = Tcl_DStringValue(prefix); Index: library/nx/nx.tcl =================================================================== diff -u -r75f60be7698fecc92f988b113075465a792f4ebc -r40b842e5b218cc6144506ff4689671b780c4e8c5 --- library/nx/nx.tcl (.../nx.tcl) (revision 75f60be7698fecc92f988b113075465a792f4ebc) +++ library/nx/nx.tcl (.../nx.tcl) (revision 40b842e5b218cc6144506ff4689671b780c4e8c5) @@ -2820,7 +2820,10 @@ foreach m [$origin ::nsf::methods::object::info::methods -path -callprotection all] { set rest [lassign [$origin ::nsf::methods::object::info::method definition $m] . protection . what .] - + #if {$what eq ""} { + # puts stderr "COPY <$m> can't handle [$origin ::nsf::methods::object::info::method definition $m] -> what '$what'" + # continue + #} # remove -returns from reported definitions set p [lsearch -exact $rest -returns]; if {$p > -1} {set rest [lreplace $rest $p $p+1]} Index: tests/class-method.test =================================================================== diff -u -r8e2e356e9bcef39f43dfe3690b82d9586c7adc72 -r40b842e5b218cc6144506ff4689671b780c4e8c5 --- tests/class-method.test (.../class-method.test) (revision 8e2e356e9bcef39f43dfe3690b82d9586c7adc72) +++ tests/class-method.test (.../class-method.test) (revision 40b842e5b218cc6144506ff4689671b780c4e8c5) @@ -50,11 +50,11 @@ # } ? {::C info object methods} "v2 p foo fwd a f" - ? {lsort [::C info object methods -callprotection protected]} "per-object-slot pm1 pm2" + ? {lsort [::C info object methods -callprotection protected]} "pm1 pm2" ? {lsort [::C info object methods -callprotection private]} "priv" ? {::C class info methods} "v2 p foo fwd a f" - ? {lsort [::C class info methods -callprotection protected]} "per-object-slot pm1 pm2" + ? {lsort [::C class info methods -callprotection protected]} "pm1 pm2" ? {lsort [::C class info methods -callprotection private]} "priv" ? {::C class info variables} "::C::per-object-slot::v2 ::C::per-object-slot::p" Index: tests/methods.test =================================================================== diff -u -r78c12b94b4cdcd5edb70a546b7bbb7c0a4724668 -r40b842e5b218cc6144506ff4689671b780c4e8c5 --- tests/methods.test (.../methods.test) (revision 78c12b94b4cdcd5edb70a546b7bbb7c0a4724668) +++ tests/methods.test (.../methods.test) (revision 40b842e5b218cc6144506ff4689671b780c4e8c5) @@ -2109,8 +2109,63 @@ rename 1000 "" } +nx::test case alias-to-object { + nsf::proc ::p {} {return p1} + nx::Object create o1 { + :public object method bar {} {return bar1} + } + nx::Class create C { + :alias A1 ::p + :alias A2 ::o1 + :forward A3 ::o1 + } + # + # We expect to see both, the alias to the proc and the alias to the + # object. We expect same results with and without "-path" specified. + # + ? {lsort [C ::nsf::methods::class::info::methods -callprotection all]} {A1 A2 A3} + ? {lsort [C ::nsf::methods::class::info::methods -callprotection all -path]} {A1 A2 A3} + nx::Class create D { + :method m {} {return m1} + :method "e f" {} {return e1} + :alias a ::o1 + nx::Class create D::D1 + nx::Object create D::d1 { + :public object method foo {} {return foo} + } + :public object method om {} {return om1} + :public object method "oe f" {} {return of1} + :public object alias oa ::o1 + :public object alias op ::p + } + ? {D op} "p1" + ? {D om} "om1" + ? {D oe f} "of1" + ? {D oa bar} "bar1" + # + # Note that we use "d1" like a method although it is not listed as a + # method (it was not registered via a method defining command). + # + ? {D d1 foo} "foo" + + ? {lsort [D ::nsf::methods::class::info::methods -callprotection all]} {a e m} + ? {lsort [D ::nsf::methods::class::info::methods -callprotection all -path]} {a {e f} m} + + # + # For per-object methods, we see a difference when "-path" is set or + # not in the number of reported methods. + # + ? {lsort [D ::nsf::methods::object::info::methods -callprotection all]} {D1 d1 oa oe om op} + ? {lsort [D ::nsf::methods::object::info::methods -callprotection all -path]} {oa {oe f} om op} + + rename ::p "" + o1 destroy + C destroy +} + + # Local variables: # mode: tcl # tcl-indent-level: 2 Index: tests/plain-object-method.test =================================================================== diff -u -r8e2e356e9bcef39f43dfe3690b82d9586c7adc72 -r40b842e5b218cc6144506ff4689671b780c4e8c5 --- tests/plain-object-method.test (.../plain-object-method.test) (revision 8e2e356e9bcef39f43dfe3690b82d9586c7adc72) +++ tests/plain-object-method.test (.../plain-object-method.test) (revision 40b842e5b218cc6144506ff4689671b780c4e8c5) @@ -40,7 +40,7 @@ :variable -incremental v2:integer 1 } ? {o info methods} "v2 p foo fwd a f" - ? {lsort [o info methods -callprotection protected]} "per-object-slot pm1 pm2" + ? {lsort [o info methods -callprotection protected]} "pm1 pm2" ? {lsort [o info methods -callprotection private]} "priv" ? {o info variables} "::o::per-object-slot::v2 ::o::per-object-slot::p"