Index: TODO =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- TODO (.../TODO) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ TODO (.../TODO) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -3872,6 +3872,12 @@ } o2 foo +- fixed potential crash from method caching, when permissions on cmds are + changed and become e.g. unresolvable +- removed flag allowmethoddispatch, since behavior can be achived via + private flag. +- extended regression test + ======================================================================== TODO: - cleanup of allowmethoddispatch / changing it maybe into private handling Index: generic/nsf.c =================================================================== diff -u -r5fd1694666b34658d4c6ac634f8e5e6b1f78ad70 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- generic/nsf.c (.../nsf.c) (revision 5fd1694666b34658d4c6ac634f8e5e6b1f78ad70) +++ generic/nsf.c (.../nsf.c) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -18833,27 +18833,13 @@ if (newTargetObject) { /* - * In case the newTargetObject is a child of the object, add redirector to - * allow calls independent from allowmethoddispatch - */ - if (GetObjectFromString(interp, Tcl_Command_nsPtr(cmd)->fullName) == object) { - newObjProc = NsfProcAliasMethod; - } - - /* TODO: for forcing redirectors on objects, do something like */ + * We set now for every alias to an object a stub proc, such we can + * distinguish between cases, where the user wants to create a method, and + * between cases, where object-invocation via method interface might + * happen. + */ newObjProc = NsfProcAliasMethod; - /* - * The new alias is pointing to an nsf object. In case no aliasMethod is - * use, increment the object reference counter of the new aliased object - * only when the new target object is different from the old one. Note, - * that the old target object might be NULL in case the object is used - * here the first time. - */ - if (newObjProc == NULL && oldTargetObject != newTargetObject) { - NsfObjectRefCountIncr(newTargetObject); - } - } else if (CmdIsProc(cmd)) { /* * When we have a Tcl proc|nsf-method as alias, then use the @@ -19195,6 +19181,11 @@ Tcl_Command_flags(cmd) &= ~impliedClearFlag; } } + if (cl) { + NsfInstanceMethodEpochIncr("Permissions"); + } else { + NsfObjectMethodEpochIncr("Permissions"); + } } Tcl_SetIntObj(Tcl_GetObjResult(interp), (Tcl_Command_flags(cmd) & flag) != 0); break; @@ -19535,7 +19526,7 @@ /* cmd "object::property" NsfObjectPropertyCmd { {-argName "objectName" -required 1 -type object} - {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|allowmethoddispatch|perobjectdispatch" -required 1} + {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch" -required 1} {-argName "value" -required 0 -type tclobj} } */ @@ -19551,7 +19542,6 @@ case ObjectpropertyRootclassIdx: flags = NSF_IS_ROOT_CLASS; break; case ObjectpropertySlotcontainerIdx: flags = NSF_IS_SLOT_CONTAINER; break; case ObjectpropertyKeepcallerselfIdx: flags = NSF_KEEP_CALLER_SELF; allowSet = 1; break; - case ObjectpropertyAllowmethoddispatchIdx: flags = NSF_ALLOW_METHOD_DISPATCH; allowSet = 1; break; case ObjectpropertyPerobjectdispatchIdx: flags = NSF_PER_OBJECT_DISPATCH; allowSet = 1; break; } Index: generic/nsfAPI.decls =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -151,7 +151,7 @@ } {-nxdoc 1} cmd "object::property" NsfObjectPropertyCmd { {-argName "objectName" -required 1 -type object} - {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|allowmethoddispatch|perobjectdispatch" -required 1} + {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch" -required 1} {-argName "value" -required 0 -type tclobj} } {-nxdoc 1} cmd "object::qualify" NsfObjectQualifyCmd { Index: generic/nsfAPI.h =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- generic/nsfAPI.h (.../nsfAPI.h) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -148,12 +148,12 @@ return result; } -enum ObjectpropertyIdx {ObjectpropertyNULL, ObjectpropertyInitializedIdx, ObjectpropertyClassIdx, ObjectpropertyRootmetaclassIdx, ObjectpropertyRootclassIdx, ObjectpropertySlotcontainerIdx, ObjectpropertyKeepcallerselfIdx, ObjectpropertyAllowmethoddispatchIdx, ObjectpropertyPerobjectdispatchIdx}; +enum ObjectpropertyIdx {ObjectpropertyNULL, ObjectpropertyInitializedIdx, ObjectpropertyClassIdx, ObjectpropertyRootmetaclassIdx, ObjectpropertyRootclassIdx, ObjectpropertySlotcontainerIdx, ObjectpropertyKeepcallerselfIdx, ObjectpropertyPerobjectdispatchIdx}; static int ConvertToObjectproperty(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"initialized", "class", "rootmetaclass", "rootclass", "slotcontainer", "keepcallerself", "allowmethoddispatch", "perobjectdispatch", NULL}; + static CONST char *opts[] = {"initialized", "class", "rootmetaclass", "rootclass", "slotcontainer", "keepcallerself", "perobjectdispatch", NULL}; (void)pPtr; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "objectproperty", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); @@ -201,7 +201,7 @@ {ConvertToRelationtype, "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"}, {ConvertToSource, "all|application|baseclasses"}, {ConvertToConfigureoption, "debug|dtrace|filter|profile|softrecreate|objectsystems|keepinitcmd|checkresults|checkarguments"}, - {ConvertToObjectproperty, "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|allowmethoddispatch|perobjectdispatch"}, + {ConvertToObjectproperty, "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch"}, {ConvertToAssertionsubcmd, "check|object-invar|class-invar"}, {NULL, NULL} }; Index: generic/nsfInt.h =================================================================== diff -u -r5fd1694666b34658d4c6ac634f8e5e6b1f78ad70 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- generic/nsfInt.h (.../nsfInt.h) (revision 5fd1694666b34658d4c6ac634f8e5e6b1f78ad70) +++ generic/nsfInt.h (.../nsfInt.h) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -381,7 +381,6 @@ #define NSF_IS_ROOT_CLASS 0x0100 #define NSF_IS_SLOT_CONTAINER 0x0200 #define NSF_KEEP_CALLER_SELF 0x0400 -#define NSF_ALLOW_METHOD_DISPATCH 0x10000 /* TODO: flag outside of range (intended)*/ #define NSF_PER_OBJECT_DISPATCH 0x0800 /* deletion state */ #define NSF_DESTROY_CALLED_SUCCESS 0x1000 Index: library/nx/nx.tcl =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- library/nx/nx.tcl (.../nx.tcl) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ library/nx/nx.tcl (.../nx.tcl) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -171,7 +171,6 @@ ::nsf::method::alias $object $w $o if {$verbose} {puts stderr "... create alias $object $w $o"} } else { - #::nsf::object::property ${object}::$w allowmethoddispatch true if {$verbose} {puts stderr "... create object $o"} } set object $o @@ -481,10 +480,7 @@ # :protected method init {} { ::nsf::object::property [self] keepcallerself true - ::nsf::object::property [self] allowmethoddispatch true ::nsf::object::property [self] perobjectdispatch true - # object property "allowmethoddispatch" is just needed for - # per-object ensembles and is set upon this creaton. } :protected method unknown {callInfo args} { set path [lrange $callInfo 1 end-1]; # set path [current methodpath] @@ -2076,7 +2072,7 @@ } # copy object -> might be a class obj ::nsf::object::property $obj keepcallerself [::nsf::object::property $origin keepcallerself] - ::nsf::object::property $obj allowmethoddispatch [::nsf::object::property $origin allowmethoddispatch] + ::nsf::object::property $obj perobjectdispatch [::nsf::object::property $origin perobjectdispatch] ::nsf::method::assertion $obj check [::nsf::method::assertion $origin check] ::nsf::method::assertion $obj object-invar [::nsf::method::assertion $origin object-invar] ::nsf::relation $obj object-filter [::nsf::relation $origin object-filter] Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -385,7 +385,6 @@ # "init" must exist on Object. per default it is empty. Object instproc init args { - ::nsf::object::property [self] allowmethoddispatch 1 if {![::nsf::current isnextcall] && [llength $args] > 0 && [::nsf::configure debug] > 0} { ::nsf::log Warning "Arguments '$args' to constructor of object [self] are most likely not processed" } @@ -465,8 +464,6 @@ Object create ::xotcl::classInfo ::nsf::object::property ::xotcl::objectInfo keepcallerself true ::nsf::object::property ::xotcl::classInfo keepcallerself true - ::nsf::object::property ::xotcl::objectInfo allowmethoddispatch true - ::nsf::object::property ::xotcl::classInfo allowmethoddispatch true ::nsf::object::property ::xotcl::objectInfo perobjectdispatch true ::nsf::object::property ::xotcl::classInfo perobjectdispatch true Index: tests/info-method.test =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- tests/info-method.test (.../info-method.test) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ tests/info-method.test (.../info-method.test) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -181,21 +181,12 @@ :public alias soAlias ::o::sub } # - # per default, we see just the alias + # per default, we see the alias and the subobject # - #? {o info methods} "soAlias" - #? {o info method type soAlias} "alias" ? {o info methods} "soAlias sub" ? {o info method type soAlias} "alias" - - # - # if allowmethoddispatch is turned on, we see the alias and the - # submethod name - # - nsf::object::property ::o::sub allowmethoddispatch on - ? {o info methods} "soAlias sub" - ? {o info method type sub} "object" - ? {o info method definition sub} "::nx::Object create ::o::sub" + + # the subobject can be hidden via private (see protection.test) } # @@ -208,19 +199,13 @@ :create c1 } # - # We see the alias to the object, no matter whether - # allowmethoddispatch on the target is turned on or off. + # We see always the alias to the object # ? {C info methods i} "i" ? {c1 info lookup methods i} "i" ? {C info methods *i} "i" ? {c1 info lookup methods *i} "i" - ::nsf::object::property ::I allowmethoddispatch 1 - ? {C info methods i} "i" - ? {c1 info lookup methods i} "i" - ? {C info methods *i} "i" - ? {c1 info lookup methods *i} "i" } Index: tests/protected.test =================================================================== diff -u -r59e100d383b22ea1407f5e5c40e303f2c6bb9027 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- tests/protected.test (.../protected.test) (revision 59e100d383b22ea1407f5e5c40e303f2c6bb9027) +++ tests/protected.test (.../protected.test) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -641,4 +641,45 @@ ? {::nsf::method::property C foo call-protected false} 0 ? {::nsf::method::property C foo call-protected} 0 ? {::nsf::method::property C foo call-private} 0 -} \ No newline at end of file +} + +# +# private subobjects +# +nx::Test case private-subobject { + nx::Object create obj { + :public method foo {} {return foo-[self]} + nx::Object create [self]::child { + :public method bar {} {return bar-[self]} + } + } + + ? {obj child bar} "bar-::obj::child" + ? {obj foo} "foo-::obj" + ? {obj info methods} "child foo" + + ? {::nsf::method::property obj foo call-private 1} 1 + + ? {obj child bar} "bar-::obj::child" + ? {obj foo} {::obj: unable to dispatch method 'foo'} + ? {obj info methods} "child" + + ? {::nsf::method::property obj child call-private 1} 1 + + ? {obj child bar} {::obj: unable to dispatch method 'child'} + ? {obj foo} {::obj: unable to dispatch method 'foo'} + ? {obj info methods} "" + + ? {::nsf::method::property obj foo call-protected 0} 0 + + ? {obj child bar} {::obj: unable to dispatch method 'child'} + ? {obj foo} "foo-::obj" + ? {obj info methods} "foo" + + ? {::nsf::method::property obj child call-protected 0} 0 + + ? {obj child bar} "bar-::obj::child" + ? {obj foo} "foo-::obj" + ? {obj info methods} "child foo" + +} Index: tests/submethods.test =================================================================== diff -u -r33d4fb2329d25b2a4e9ba05d312dfde2c73c3409 -rf61ee3dfc17d8cf04a0dc9ada9cb0f939514a511 --- tests/submethods.test (.../submethods.test) (revision 33d4fb2329d25b2a4e9ba05d312dfde2c73c3409) +++ tests/submethods.test (.../submethods.test) (revision f61ee3dfc17d8cf04a0dc9ada9cb0f939514a511) @@ -544,7 +544,7 @@ # Test forwarding to child object, with respect to settings of the # object properties keepcallerself and allowmethoddispatch # - +nx::Test parameter count 1000 nx::Test case child-obj-delegation { nx::Object create obj { @@ -561,18 +561,19 @@ # # Default case # keepcallerself false - # allowmethoddispatch false + # perobjectdispatch false # ::nsf::object::property obj::child keepcallerself false - ::nsf::object::property obj::child allowmethoddispatch false + ::nsf::object::property obj::child perobjectdispatch false ? {obj link1 foo} {::obj::child} #? {obj link2 foo} {::obj: unable to dispatch method 'child'} ? {obj link2 foo} {::obj::child} ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj::child} ? {obj link5 foo} {::obj::child} + ? {obj child foo} {::obj::child} #? {lsort [obj info methods child]} {} #? {lsort [obj info methods]} {link1 link2 link3 link4 link5} @@ -584,10 +585,9 @@ ? {lsort [obj info lookup methods child*]} {child} # - # turn on keepcallerself + # turn on keepcallerself and perobjectdispatch # ::nsf::object::property obj::child keepcallerself true - ::nsf::object::property obj::child allowmethoddispatch false ::nsf::object::property obj::child perobjectdispatch true ? {obj link1 foo} {::obj::child} @@ -596,6 +596,7 @@ ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj} ? {obj link5 foo} {::obj::child} + ? {obj child foo} {::obj} #? {lsort [obj info methods child]} {} #? {lsort [obj info methods]} {link1 link2 link3 link4 link5} @@ -608,33 +609,35 @@ # - # turn on allowmethoddispatch + # just perobjectdispatch # ::nsf::object::property obj::child keepcallerself false - ::nsf::object::property obj::child allowmethoddispatch true + ::nsf::object::property obj::child perobjectdispatch true ? {obj link1 foo} {::obj::child} ? {obj link2 foo} {::obj::child} ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj::child} ? {obj link5 foo} {::obj::child} + ? {obj child foo} {::obj::child} ? {lsort [obj info methods child]} {child} ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} # - # turn on allowmethoddispatch and keepcallerself + # just keepcallerself # ::nsf::object::property obj::child keepcallerself true - ::nsf::object::property obj::child allowmethoddispatch true + ::nsf::object::property obj::child perobjectdispatch false ? {obj link1 foo} {::obj::child} - ? {obj link2 foo} {::obj} + ? {obj link2 foo} {::obj: unable to dispatch method 'foo'} ? {obj link3 foo} {::obj::child} - ? {obj link4 foo} {::obj} + ? {obj link4 foo} {::obj: unable to dispatch method 'foo'} ? {obj link5 foo} {::obj::child} + ? {obj child foo} {::obj: unable to dispatch method 'foo'} ? {lsort [obj info methods child]} {child} ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5}