Index: TODO =================================================================== diff -u -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 -rabc4e7b7e4192e83072f23bf7849ab3e2b61c09c --- TODO (.../TODO) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) +++ TODO (.../TODO) (revision abc4e7b7e4192e83072f23bf7849ab3e2b61c09c) @@ -3878,18 +3878,18 @@ private flag. - extended regression test +- extend regression test for interactions between "keepcallerself" and + "perobjectdispatch" +- some minor cleanup + + ======================================================================== TODO: -- cleanup of allowmethoddispatch / changing it maybe into private handling -- corollary: for complete configurability of method dispatch, we would - need as well a 3rd object-property: restrict-dispatch-to-object-methods - -- pertaining allowmethoddispatch and keepcallerself in serializer -- setting of allowmethoddispatch in XOTcl is weak, since set over constructor, - which migh be overwritten by application classes +- pertaining perobjectdispatch and keepcallerself in serializer - should we allow objects to overwrite procs/methods and vice versa? -- behavior on keepcallerself on ordinary dispatches with implicit/explicit receiver +- behavior on keepcallerself on ordinary dispatches with implicit/explicit + receiver (currently the flag is ignored, the code just commented out) - Aliases and forwards are not handled by NsfNSCopyCmdsCmd; object cloning/copying remains incomplete; also, there might be object and Index: generic/nsf.c =================================================================== diff -u -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 -rabc4e7b7e4192e83072f23bf7849ab3e2b61c09c --- generic/nsf.c (.../nsf.c) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) +++ generic/nsf.c (.../nsf.c) (revision abc4e7b7e4192e83072f23bf7849ab3e2b61c09c) @@ -9715,13 +9715,15 @@ tcd->objProc = objProc; tcd->aliasedCmd = cmd; tcd->clientData = Tcl_Command_objClientData(cmd); - */ + + * There is no need to iterate during dereferencing, since the target cmd + * is already dereferenced. + */ cmd = tcd->aliasedCmd; proc = Tcl_Command_objProc(cmd); cp = Tcl_Command_objClientData(cmd); - /* TODO: dereference chain? */ } /*fprintf(stderr, "MethodDispatch method '%s' cmd %p %s clientData %p cp=%p objc=%d cscPtr %p csc->flags %.6x \n", @@ -9775,9 +9777,7 @@ */ return result; - } else if (proc == NsfObjDispatch - /*//&& ((o = NsfGetObjectFromCmdPtr(cmd)) && o->id == cmd && (o->flags & NSF_PER_OBJECT_DISPATCH))*/ - ) { + } else if (proc == NsfObjDispatch) { assert(cp); return ObjectCmdMethodDispatch((NsfObject *)cp, interp, objc, objv, @@ -10302,16 +10302,13 @@ object, methodName, object->nsPtr, cmd, cmd ? ((Command *)cmd)->objProc : NULL);*/ if (cmd) { - //NsfObject *o; - /* * Reject call when * a) trying to call a private method without the local flag or ignore permssions, or * b) trying to call an object with no method interface */ if (((flags & (NSF_CM_LOCAL_METHOD|NSF_CM_IGNORE_PERMISSIONS)) == 0 && (Tcl_Command_flags(cmd) & NSF_CMD_CALL_PRIVATE_METHOD)) - //|| ((o = NsfGetObjectFromCmdPtr(cmd)) && o->id == cmd && (o->flags & NSF_ALLOW_METHOD_DISPATCH) == 0) ) { cmd = NULL; } else { @@ -18793,9 +18790,6 @@ * * 5. arbitrary Tcl commands (e.g. set, ..., ::nsf::relation, ...) * - * TODO GN: i think, we should use NsfProcAliasMethod, whenever the clientData - * is not 0. These are the cases, where the clientData will be freed, - * when the original command is deleted. */ if (withFrame == FrameObjectIdx) { Index: tests/submethods.test =================================================================== diff -u -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 -rabc4e7b7e4192e83072f23bf7849ab3e2b61c09c --- tests/submethods.test (.../submethods.test) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) +++ tests/submethods.test (.../submethods.test) (revision abc4e7b7e4192e83072f23bf7849ab3e2b61c09c) @@ -541,6 +541,84 @@ # +# Test keepcallerself and perobjectdispatch with their respective +# interactions for plain object dispatch and for object dispatch via +# method interface +# + +nx::Test case per-object-dispatch { + nx::Class create C { + :public method foo {} {return foo-[self]} + :public method baz {} {return [c1::1 baz]} + :create c1 { + :public method bar {} {return bar-[self]} + } + } + + ? {c1 foo} "foo-::c1" + ? {c1 bar} "bar-::c1" + + C create c1::1 { + :public method bar {} {return bar-[self]} + :public method baz {} {return baz-[self]} + } + + # + # Just the same as above + # + ? {c1::1 foo} "foo-::c1::1" + ? {c1::1 bar} "bar-::c1::1" + + # if we specify anything special, then we have per-default + # - keepcallerself false + # - perobjectdispatch false + + ? {c1 1 foo} "foo-::c1::1" + ? {c1 1 bar} "bar-::c1::1" + ? {c1 baz} "baz-::c1::1" + + # just make setting explicit + ::nsf::object::property ::c1::1 keepcallerself off + ::nsf::object::property ::c1::1 perobjectdispatch off + ? {c1 1 foo} "foo-::c1::1" + ? {c1 1 bar} "bar-::c1::1" + ? {c1 baz} "baz-::c1::1" + + # keepcallerself off - the self in the called method is the invoked object + # perobjectdispatch on - the instance method is not callable + + ::nsf::object::property ::c1::1 keepcallerself off + ::nsf::object::property ::c1::1 perobjectdispatch on + + ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'} + ? {c1 1 bar} "bar-::c1::1" + ? {c1 baz} "baz-::c1::1" + + # keepcallerself on - the self in the called method is the caller + # perobjectdispatch on - the instance method is not callable + + ::nsf::object::property ::c1::1 keepcallerself on + ::nsf::object::property ::c1::1 perobjectdispatch on + + ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'} + ? {c1 1 bar} "bar-::c1" + #### ignore keepcallerself via interface with explicit receiver intentionally + ? {c1 baz} "baz-::c1::1" + + # keepcallerself on - the self in the called method is the caller + # perobjectdispatch off - the instance method is callable + + ::nsf::object::property ::c1::1 keepcallerself on + ::nsf::object::property ::c1::1 perobjectdispatch off + + ? {c1 1 foo} "foo-::c1" + ? {c1 1 bar} "bar-::c1" + #### ignore keepcallerself via interface with explicit receiver intentionally + ? {c1 baz} "baz-::c1::1" +} + + +# # Test forwarding to child object, with respect to settings of the # object properties keepcallerself and allowmethoddispatch # @@ -643,4 +721,6 @@ ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} -} \ No newline at end of file +} + +