Index: TODO =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- TODO (.../TODO) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ TODO (.../TODO) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1667,6 +1667,12 @@ - changed option -expand in "info methods" and "info lookup methods" into "-path" to associate with the method path +- changed method property name from "protected" to "call-protected" +- changed nx::defaultMethodProtection to nx::defaultMethodCallProtection +- nx::defaultAttributeProtection is used for + scripted methods, forwarders and aliases +- added nx::defaultAttributeProtection, + used for setter and attributes TODO: Index: generic/gentclAPI.decls =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -111,7 +111,7 @@ {-argName "object" -required 1 -type object} {-argName "-per-object"} {-argName "methodName" -required 1 -type tclobj} - {-argName "methodproperty" -required 1 -type "class-only|protected|redefine-protected|returns|slotcontainer|slotobj"} + {-argName "methodproperty" -required 1 -type "class-only|call-protected|redefine-protected|returns|slotcontainer|slotobj"} {-argName "value" -type tclobj} } nsfCmd my NsfMyCmd { Index: generic/nsf.c =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- generic/nsf.c (.../nsf.c) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ generic/nsf.c (.../nsf.c) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -12958,12 +12958,12 @@ switch (methodproperty) { case MethodpropertyClass_onlyIdx: /* fall through */ - case MethodpropertyProtectedIdx: /* fall through */ + case MethodpropertyCall_protectedIdx: /* fall through */ case MethodpropertyRedefine_protectedIdx: /* fall through */ { switch (methodproperty) { case MethodpropertyClass_onlyIdx: flag = NSF_CMD_CLASS_ONLY_METHOD; break; - case MethodpropertyProtectedIdx: flag = NSF_CMD_PROTECTED_METHOD; break; + case MethodpropertyCall_protectedIdx: flag = NSF_CMD_PROTECTED_METHOD; break; case MethodpropertyRedefine_protectedIdx: flag = NSF_CMD_REDEFINE_PROTECTED_METHOD; break; } Index: generic/tclAPI.h =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- generic/tclAPI.h (.../tclAPI.h) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ generic/tclAPI.h (.../tclAPI.h) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -79,13 +79,13 @@ static int ConvertToMethodproperty(Tcl_Interp *interp, Tcl_Obj *objPtr, NsfParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"class-only", "protected", "redefine-protected", "returns", "slotcontainer", "slotobj", NULL}; + static CONST char *opts[] = {"class-only", "call-protected", "redefine-protected", "returns", "slotcontainer", "slotobj", NULL}; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "methodproperty", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); *outObjPtr = objPtr; return result; } -enum MethodpropertyIdx {MethodpropertyNULL, MethodpropertyClass_onlyIdx, MethodpropertyProtectedIdx, MethodpropertyRedefine_protectedIdx, MethodpropertyReturnsIdx, MethodpropertySlotcontainerIdx, MethodpropertySlotobjIdx}; +enum MethodpropertyIdx {MethodpropertyNULL, MethodpropertyClass_onlyIdx, MethodpropertyCall_protectedIdx, MethodpropertyRedefine_protectedIdx, MethodpropertyReturnsIdx, MethodpropertySlotcontainerIdx, MethodpropertySlotobjIdx}; static int ConvertToRelationtype(Tcl_Interp *interp, Tcl_Obj *objPtr, NsfParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { Index: library/nx/nx.tcl =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- library/nx/nx.tcl (.../nx.tcl) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ library/nx/nx.tcl (.../nx.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -60,11 +60,11 @@ # set a few aliases as protected # "__next", if defined, should be added as well foreach cmd [list cleanup noinit residualargs uplevel upvar] { - ::nsf::methodproperty Object $cmd protected 1 + ::nsf::methodproperty Object $cmd call-protected 1 } foreach cmd [list recreate] { - ::nsf::methodproperty Class $cmd protected 1 + ::nsf::methodproperty Class $cmd call-protected 1 } # protect some methods against redefinition @@ -128,12 +128,15 @@ return [list object $object methodName $methodName] } - ::nsf::methodproperty Object __resolve_method_path protected true + ::nsf::methodproperty Object __resolve_method_path call-protected true - ::nsf::method Object __default_method_protection args {return false} - ::nsf::methodproperty Object __default_method_protection protected true + ::nsf::method Object __default_method_call_protection args {return false} + ::nsf::method Object __default_attribute_call_protection args {return false} + ::nsf::methodproperty Object __default_method_call_protection call-protected true + ::nsf::methodproperty Object __default_attribute_call_protection call-protected true + # define method "method" for Class and Object ::nsf::method Class method { @@ -147,7 +150,7 @@ set r [::nsf::method $(object) $(methodName) $arguments $body {*}$conditions] if {$r ne ""} { # the method was not deleted - ::nsf::methodproperty $(object) $r protected [::nsf::dispatch $(object) __default_method_protection] + ::nsf::methodproperty $(object) $r call-protected [::nsf::dispatch $(object) __default_method_call_protection] if {[info exists returns]} {::nsf::methodproperty $(object) $r returns $returns} } return $r @@ -164,7 +167,7 @@ set r [::nsf::method $(object) -per-object $(methodName) $arguments $body {*}$conditions] if {$r ne ""} { # the method was not deleted - ::nsf::methodproperty $(object) $r protected [::nsf::dispatch $(object) __default_method_protection] + ::nsf::methodproperty $(object) $r call-protected [::nsf::dispatch $(object) __default_method_call_protection] if {[info exists returns]} {::nsf::methodproperty $(object) $r returns $returns} } return $r @@ -213,7 +216,7 @@ Consider '[::nsf::current object] create $m $args' instead of '[::nsf::current object] $m $args'" } # protected is not yet defined - ::nsf::methodproperty [::nsf::current object] unknown protected true + ::nsf::methodproperty [::nsf::current object] unknown call-protected true } @@ -224,7 +227,7 @@ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}] if {$p == -1} {error "$args is not a method defining method"} set r [{*}:$args] - ::nsf::methodproperty [::nsf::current object] $r protected false + ::nsf::methodproperty [::nsf::current object] $r call-protected false return $r } @@ -233,7 +236,7 @@ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}] if {$p == -1} {error "$args is not a method defining command"} set r [{*}:$args] - ::nsf::methodproperty [::nsf::current object] $r [::nsf::current method] true + ::nsf::methodproperty [::nsf::current object] $r call-protected true return $r } } @@ -277,17 +280,23 @@ target:optional args } { array set "" [:__resolve_method_path -per-object $method] - return [::nsf::forward $(object) -per-object $(methodName) \ - {*}[lrange [::nsf::current args] 1 end]] + set r [::nsf::forward $(object) -per-object $(methodName) \ + {*}[lrange [::nsf::current args] 1 end]] + ::nsf::methodproperty $(object) -per-object $r call-protected \ + [::nsf::dispatch $(object) __default_method_call_protection] + return $r } Class public method forward { method -default -methodprefix -objscope:switch -onerror -verbose:switch target:optional args } { array set "" [:__resolve_method_path $method] - return [::nsf::forward $(object) $(methodName) \ + set r [::nsf::forward $(object) $(methodName) \ {*}[lrange [::nsf::current args] 1 end]] + ::nsf::methodproperty $(object) $r call-protected \ + [::nsf::dispatch $(object) __default_method_call_protection] + return $r } # @@ -309,28 +318,42 @@ Object public method alias {-nonleaf:switch -objscope:switch methodName cmd} { array set "" [:__resolve_method_path -per-object $methodName] #puts "object alias $(object).$(methodName) $cmd" - ::nsf::alias $(object) -per-object $(methodName) \ - {*}[expr {${objscope} ? "-objscope" : ""}] \ - {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ - $cmd + set r [::nsf::alias $(object) -per-object $(methodName) \ + {*}[expr {${objscope} ? "-objscope" : ""}] \ + {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ + $cmd] + ::nsf::methodproperty $(object) -per-object $r call-protected \ + [::nsf::dispatch $(object) __default_method_call_protection] + return $r } Class public method alias {-nonleaf:switch -objscope:switch methodName cmd} { array set "" [:__resolve_method_path $methodName] #puts "class alias $(object).$(methodName) $cmd" - ::nsf::alias $(object) $(methodName) \ - {*}[expr {${objscope} ? "-objscope" : ""}] \ - {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ - $cmd + set r [::nsf::alias $(object) $(methodName) \ + {*}[expr {${objscope} ? "-objscope" : ""}] \ + {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ + $cmd] + ::nsf::methodproperty $(object) $r call-protected \ + [::nsf::dispatch $(object) __default_method_call_protection] + return $r } # Add setter methods. # Object public method setter {parameter} { - ::nsf::setter [::nsf::current object] -per-object $parameter + set o [::nsf::current object] + set r [::nsf::setter $o -per-object $parameter] + ::nsf::methodproperty $o -per-object $r call-protected \ + [::nsf::dispatch $o __default_attribute_call_protection] + return $r } Class public method setter {parameter} { - ::nsf::setter [::nsf::current object] $parameter + set o [::nsf::current object] + set r [::nsf::setter $o $parameter] + ::nsf::methodproperty $o $r call-protected \ + [::nsf::dispatch $o __default_attribute_call_protection] + return $r } # Add method "require" @@ -371,7 +394,7 @@ set slotContainer ${baseObject}::slot if {![::nsf::isobject $slotContainer]} { ::nx::Object alloc $slotContainer - ::nsf::methodproperty ${baseObject} -per-object slot protected true + ::nsf::methodproperty ${baseObject} -per-object slot call-protected true ::nsf::methodproperty ${baseObject} -per-object slot redefine-protected true ::nsf::methodproperty ${baseObject} -per-object slot slotcontainer true $slotContainer ::nsf::methods::object::requirenamespace @@ -1109,8 +1132,8 @@ # mixin class for optimizing slots Class create ::nx::Attribute::Optimizer { - :method method args {set r [::nsf::next]; :optimize; return $r} - :method forward args {set r [::nsf::next]; :optimize; return $r} + :public method method args {set r [::nsf::next]; :optimize; return $r} + :public method forward args {set r [::nsf::next]; :optimize; return $r} :protected method init args {set r [::nsf::next]; :optimize; return $r} :public method optimize {} { @@ -1167,11 +1190,19 @@ # Define method "attribute" for convenience ############################################ Class method attribute {spec {-slotclass ::nx::Attribute} {initblock ""}} { - $slotclass createFromParameterSyntax [::nsf::current object] -initblock $initblock {*}$spec + set r [$slotclass createFromParameterSyntax [::nsf::current object] -initblock $initblock {*}$spec] + set o [::nsf::current object] + ::nsf::methodproperty $o $r call-protected \ + [::nsf::dispatch $o __default_attribute_call_protection] + return $r } Object method attribute {spec {-slotclass ::nx::Attribute} {initblock ""}} { - $slotclass createFromParameterSyntax [::nsf::current object] -per-object -initblock $initblock {*}$spec + set r [$slotclass createFromParameterSyntax [::nsf::current object] -per-object -initblock $initblock {*}$spec] + set o [::nsf::current object] + ::nsf::methodproperty $o -per-object $r call-protected \ + [::nsf::dispatch $o __default_attribute_call_protection] + return $r } ############################################ @@ -1462,30 +1493,45 @@ # # Set the default method protection for nx methods. This # protection level is used per default for all method definitions - # without explicit protection specified. + # of scripted methods, aliases and forwarders without explicit + # protection specified. # - :method defaultMethodProtection {value:boolean,optional} { + :method defaultMethodCallProtection {value:boolean,optional} { if {[info exists value]} { - ::nsf::method Object __default_method_protection args [list return $value] - ::nsf::methodproperty Object __default_method_protection protected true + ::nsf::method Object __default_method_call_protection args [list return $value] + ::nsf::methodproperty Object __default_method_call_protection call-protected true } - return [::nsf::dispatch [::nx::current object] __default_method_protection] + return [::nsf::dispatch [::nx::current object] __default_method_call_protection] } + + # + # Set the default method protection for nx methods. This + # protection level is used per default for definitions of + # attributes and setters + # + :method defaultAttributeCallProtection {value:boolean,optional} { + if {[info exists value]} { + ::nsf::method Object __default_attribute_call_protection args [list return $value] + ::nsf::methodproperty Object __default_attribute_call_protection call-protected true + } + return [::nsf::dispatch [::nx::current object] __default_attribute_call_protection] + } } # # Make the default protected methods # - ::nx::configure defaultMethodProtection true + ::nx::configure defaultMethodCallProtection true + ::nx::configure defaultAttributeCallProtection false # # Provide an ensemble-like interface to the ::nsf primitiva to # access variables. Note that aliasing in the next scripting # framework is faster than namespace-ensembles. # Object create ::nx::var { - :alias exists ::nsf::existsvar - :alias import ::nsf::importvar - :alias set ::nsf::setvar + :public alias exists ::nsf::existsvar + :public alias import ::nsf::importvar + :public alias set ::nsf::setvar } interp alias {} ::nx::self {} ::nsf::current object Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r9192f5357a1e33963b94d42997b927c7c5fbd285 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 9192f5357a1e33963b94d42997b927c7c5fbd285) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -221,12 +221,12 @@ ::nsf::methodproperty Class create redefine-protected true # - # define parametercmd and instparametercmd in terms of ::nx method setter + # define parametercmd and instparametercmd in terms of ::nsf::setter # define filterguard and instfilterguard in terms of filterguard # define mixinguard and instmixinguard in terms of mixinguard # - ::nsf::alias Object parametercmd ::nsf::classes::nx::Object::setter - ::nsf::alias Class instparametercmd ::nsf::classes::nx::Class::setter + ::nsf::forward Object parametercmd ::nsf::setter %self -per-object + ::nsf::forward Class instparametercmd ::nsf::setter %self ::nsf::alias Object filterguard ::nsf::methods::object::filterguard ::nsf::alias Class instfilterguard ::nsf::methods::class::filterguard Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -r1bc14766b62efc778ac40c26b1bbabac116a9f80 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 1bc14766b62efc778ac40c26b1bbabac116a9f80) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -3157,7 +3157,7 @@ ::errorCheck [lsort [b info methods -nocmds]] "abstract check extractConfigureArg f filtersearch hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc proc procsearch self setFilter signature unknown" "b info methods -nocmds" - ::errorCheck [lsort [b info methods -noprocs]] "append array autoname class cleanup configure destroy eval exists filter filterguard forward incr info instvar invar lappend mixin mixinguard noinit requireNamespace residualargs set subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" + ::errorCheck [lsort [b info methods -noprocs]] "append array autoname class cleanup configure destroy eval exists filter filterguard forward incr info instvar invar lappend mixin mixinguard noinit parametercmd requireNamespace residualargs set subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract check extractConfigureArg f filtersearch hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 objectparameter objproc proc procsearch self setFilter signature unknown" "b info methods -nocmds -nomixins" ::errorCheck [b info methods -nocmds -noprocs] "" "b info methods -nocmds -noprocs" Index: tests/aliastest.tcl =================================================================== diff -u -r51725aa434e18e9e3ce656897011c4f40c98d8dd -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/aliastest.tcl (.../aliastest.tcl) (revision 51725aa434e18e9e3ce656897011c4f40c98d8dd) +++ tests/aliastest.tcl (.../aliastest.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package require nx; namespace import -force ::nx::* -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test parameter count 10 Index: tests/destroytest.tcl =================================================================== diff -u -rbedb248602f8940383c0f4a10bb4f99b3a5f2c4f -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/destroytest.tcl (.../destroytest.tcl) (revision bedb248602f8940383c0f4a10bb4f99b3a5f2c4f) +++ tests/destroytest.tcl (.../destroytest.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package require nx; namespace import ::nx::* -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test parameter count 10 Index: tests/forwardtest.tcl =================================================================== diff -u -r0c534a6693afbced7859c4189b62e712acc8f955 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/forwardtest.tcl (.../forwardtest.tcl) (revision 0c534a6693afbced7859c4189b62e712acc8f955) +++ tests/forwardtest.tcl (.../forwardtest.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -6,13 +6,13 @@ # trivial object delegation ########################################### Test case delegation { - Object create dog - Object create tail { - :public method wag args { return $args } - } - dog forward wag tail %proc - - ? {dog wag 100} 100 + Object create dog + Object create tail { + :public method wag args { return $args } + } + dog public forward wag tail %proc + + ? {dog wag 100} 100 } @@ -22,7 +22,7 @@ Test case inscope { Class create X { :attribute {x 1} - :forward Incr -objscope incr + :public forward Incr -objscope incr } X create x1 -x 100 @@ -37,7 +37,7 @@ ########################################### Test case adding { Object create obj { - :forward addOne expr 1 + + :public forward addOne expr 1 + } ? {obj addOne 5} 6 @@ -51,12 +51,12 @@ :public method foo args {return $args} } Object create obj { - :forward foo target %proc %self a1 a2 + :public forward foo target %proc %self a1 a2 } ? {obj foo x1 x2} [list ::obj a1 a2 x1 x2] - obj forward foo target %proc %self %%self %%p + obj public forward foo target %proc %self %%self %%p ? {obj foo x1 x2} [list ::obj %self %p x1 x2] } @@ -69,13 +69,13 @@ } Object create obj { - :forward Mixin mixin %1 %self + :public forward Mixin mixin %1 %self } ? {obj Mixin add M1} [list ::mixin add ::obj M1] ? {catch {obj Mixin}} 1 - obj forward Mixin mixin "%1 {Getter Setter}" %self + obj public forward Mixin mixin "%1 {Getter Setter}" %self ? {obj Mixin add M1} [list ::mixin add ::obj M1] ? {obj Mixin M1} [list ::mixin Setter ::obj M1] ? {obj Mixin} [list ::mixin Getter ::obj] @@ -98,7 +98,7 @@ return $result } } - Object forward Info -methodprefix @ Info %1 %self + Object public forward Info -methodprefix @ Info %1 %self Class create X { :create x1 @@ -113,7 +113,7 @@ Test case incr { Object create obj { set :x 1 - :forward i1 -objscope incr x + :public forward i1 -objscope incr x } ? {obj i1} 2 @@ -124,11 +124,11 @@ ########################################### Test case introspection { Class create C { - :forward Info -methodprefix @ Info %1 %self + :public forward Info -methodprefix @ Info %1 %self } ? {C info methods -methodtype forwarder} Info - C forward XXXo x + C public forward XXXo x ? {lsort [C info methods -methodtype forwarder]} [list Info XXXo] ? {C info methods -methodtype forwarder X*} [list XXXo] @@ -143,10 +143,10 @@ # check introspection for objects Object create obj { - :forward i1 -objscope incr x - :forward Mixin mixin %1 %self - :forward foo target %proc %self %%self %%p - :forward addOne expr 1 + + :public forward i1 -objscope incr x + :public forward Mixin mixin %1 %self + :public forward foo target %proc %self %%self %%p + :public forward addOne expr 1 + } ? {lsort [obj info methods -methodtype forwarder]} "Mixin addOne foo i1" @@ -176,13 +176,13 @@ Test case optional-target { Object create obj { set :x 2 - :forward append -objscope + :public forward append -objscope } ? {obj append x y z} 2yz Object create n; Object create n::x {:public method current {} {current}} Object create o - o forward ::n::x + o public forward ::n::x ? {o x current} ::n::x } @@ -192,7 +192,7 @@ Test case percent-cmd { Object create obj { set :x 10 - :forward x* expr {%:eval {set :x}} * + :public forward x* expr {%:eval {set :x}} * } ? {obj x* 10} "100" } @@ -202,56 +202,56 @@ ########################################### Test case positioning-args { Object create obj - obj forward @end-13 list {%@end 13} + obj public forward @end-13 list {%@end 13} ? {obj @end-13 1 2 3 } [list 1 2 3 13] - obj forward @-1-13 list {%@-1 13} + obj public forward @-1-13 list {%@-1 13} ? {obj @-1-13 1 2 3 } [list 1 2 13 3] - obj forward @1-13 list {%@1 13} + obj public forward @1-13 list {%@1 13} ? {obj @1-13 1 2 3 } [list 13 1 2 3] ? {obj @1-13} [list 13] - obj forward @2-13 list {%@2 13} + obj public forward @2-13 list {%@2 13} ? {obj @2-13 1 2 3 } [list 1 13 2 3] - obj forward @list 10 {%@0 list} {%@end 99} + obj public forward @list 10 {%@0 list} {%@end 99} ? {obj @list} [list 10 99] ? {obj @list a b c} [list 10 a b c 99] - obj forward @list {%@end 99} {%@0 list} 10 + obj public forward @list {%@end 99} {%@0 list} 10 ? {obj @list} [list 10 99] ? {obj @list a b c} [list 10 a b c 99] - obj forward @list {%@2 2} {%@1 1} {%@0 list} + obj public forward @list {%@2 2} {%@1 1} {%@0 list} ? {obj @list} [list 1 2] ? {obj @list a b c} [list 1 2 a b c] - obj forward @list x y z {%@0 list} {%@1 1} {%@2 2} + obj public forward @list x y z {%@0 list} {%@1 1} {%@2 2} ? {obj @list} [list 1 2 x y z] ? {obj @list a b c} [list 1 2 x y z a b c] - obj forward @list x y z {%@2 2} {%@1 1} {%@0 list} + obj public forward @list x y z {%@2 2} {%@1 1} {%@0 list} ? {obj @list} [list x 1 y 2 z] ? {obj @list a b c} [list x 1 y 2 z a b c] # adding some test cases which cover the interactions # between %@POS and %1 substitutions # - obj forward @end-13 list {%@end 13} %1 %self + obj public forward @end-13 list {%@end 13} %1 %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13] - obj forward @end-13 list %1 {%@end 13} %self + obj public forward @end-13 list %1 {%@end 13} %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13] - obj forward @end-13 list {%@end 13} %1 %1 %1 %self + obj public forward @end-13 list {%@end 13} %1 %1 %1 %self ? {obj @end-13 1 2 3 } [list 1 1 1 ::obj 2 3 13] - obj forward @end-13 list {%@-1 13} %1 %self + obj public forward @end-13 list {%@-1 13} %1 %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 13 3] - obj forward @end-13 list {%@1 13} %1 %self + obj public forward @end-13 list {%@1 13} %1 %self ? {obj @end-13 1 2 3 } [list 13 1 ::obj 2 3] } @@ -260,7 +260,7 @@ ############################################### Test case num-args { Object create obj { - :forward f %self [list %argclindex [list a b c]] + :public forward f %self [list %argclindex [list a b c]] :method a args {return [list [current method] $args]} :method b args {return [list [current method] $args]} :method c args {return [list [current method] $args]} @@ -276,7 +276,7 @@ ############################################### Test case earlybinding { Object create obj { - :forward s -earlybinding ::set ::X + :public forward s -earlybinding ::set ::X } ? {obj s 100} 100 ? {obj s} 100 @@ -361,7 +361,7 @@ # forward to expr + callstack ########################################### Test case callstack { - Object forward expr -objscope + Object public forward expr -objscope Class create C { :method xx {} {current} Index: tests/info-method.tcl =================================================================== diff -u -rfdab3b9e05d21cb92835b9128193c7ba329d583d -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/info-method.tcl (.../info-method.tcl) (revision fdab3b9e05d21cb92835b9128193c7ba329d583d) +++ tests/info-method.tcl (.../info-method.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package req nx -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test case base { @@ -81,11 +81,11 @@ ? {lsort [C info lookup methods -source baseclasses]} $class_methods ? {lsort [c1 info lookup methods -source baseclasses]} $object_methods - ::nx::configure defaultMethodProtection true + ::nx::configure defaultMethodCallProtection true # - # the subsequent tests assume defaultMethodProtection == true + # the subsequent tests assume defaultMethodCallProtection == true # - ? {::nx::configure defaultMethodProtection} true + ? {::nx::configure defaultMethodCallProtection} true ::nx::Class create MC -superclass ::nx::Class { :protected method bar1 args {;} @@ -99,13 +99,13 @@ ? {lsort [MC info methods -methodtype scripted -callprotection all]} "bar1 bar2 foo" - ::nsf::methodproperty ::MC foo protected true - ::nsf::methodproperty ::MC bar2 protected false + ::nsf::methodproperty ::MC foo call-protected true + ::nsf::methodproperty ::MC bar2 call-protected false ? {lsort [MC info methods -methodtype scripted -callprotection public]} "bar2" ? {lsort [MC info methods -methodtype scripted -callprotection protected]} "bar1 foo" ? {lsort [MC info methods -methodtype scripted -callprotection all]} "bar1 bar2 foo" - ::nx::configure defaultMethodProtection false + ::nx::configure defaultMethodCallProtection false } Test case subobj { Index: tests/method-modifiers.tcl =================================================================== diff -u -r29ea21bd3f28ea7effaca6039e59a8a3499f8fd8 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision 29ea21bd3f28ea7effaca6039e59a8a3499f8fd8) +++ tests/method-modifiers.tcl (.../method-modifiers.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package require nx; namespace import ::nx::* -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test parameter count 10 Index: tests/parameters.tcl =================================================================== diff -u -r06ee7ba8b56117d63ad5ef251885efc92be5ddf5 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/parameters.tcl (.../parameters.tcl) (revision 06ee7ba8b56117d63ad5ef251885efc92be5ddf5) +++ tests/parameters.tcl (.../parameters.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,6 +1,6 @@ package require nx package require nx::test -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false namespace import ::nx::* Test case dummy { Index: tests/protected.tcl =================================================================== diff -u -r29ea21bd3f28ea7effaca6039e59a8a3499f8fd8 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/protected.tcl (.../protected.tcl) (revision 29ea21bd3f28ea7effaca6039e59a8a3499f8fd8) +++ tests/protected.tcl (.../protected.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -24,7 +24,7 @@ ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} -::nsf::methodproperty C SET protected true +::nsf::methodproperty C SET call-protected true ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} ? {::nsf::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 foo} {foo} @@ -34,7 +34,7 @@ ? {catch {c2 bar-SET} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} ? {c2 bar-foo} {foo} -::nsf::methodproperty C foo protected true +::nsf::methodproperty C foo call-protected true ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} ? {::nsf::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 bar} {bar} "other method work" @@ -45,12 +45,12 @@ ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} # unset protected -? {::nsf::methodproperty C SET protected} 1 -::nsf::methodproperty C SET protected false -? {::nsf::methodproperty C SET protected} 0 -? {::nsf::methodproperty C foo protected} 1 -::nsf::methodproperty C foo protected false -? {::nsf::methodproperty C foo protected} 0 +? {::nsf::methodproperty C SET call-protected} 1 + ::nsf::methodproperty C SET call-protected false +? {::nsf::methodproperty C SET call-protected} 0 +? {::nsf::methodproperty C foo call-protected} 1 + ::nsf::methodproperty C foo call-protected false +? {::nsf::methodproperty C foo call-protected} 0 ? {c1 SET x 3} 3 ? {::nsf::dispatch c1 SET x 2} {2} @@ -63,7 +63,7 @@ # define a protected method C protected method foo {} {return [current method]} -? {::nsf::methodproperty C SET protected} 0 +? {::nsf::methodproperty C SET call-protected} 0 ? {c1 SET x 3} 3 ? {::nsf::dispatch c1 SET x 4} {4} ? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} Index: tests/returns.tcl =================================================================== diff -u -r29ea21bd3f28ea7effaca6039e59a8a3499f8fd8 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/returns.tcl (.../returns.tcl) (revision 29ea21bd3f28ea7effaca6039e59a8a3499f8fd8) +++ tests/returns.tcl (.../returns.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package require nx -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test # Index: tests/submethods.tcl =================================================================== diff -u -r0c534a6693afbced7859c4189b62e712acc8f955 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/submethods.tcl (.../submethods.tcl) (revision 0c534a6693afbced7859c4189b62e712acc8f955) +++ tests/submethods.tcl (.../submethods.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,6 +1,6 @@ package req nx namespace import ::nx::* -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test case submethods { Index: tests/var-access.tcl =================================================================== diff -u -r29ea21bd3f28ea7effaca6039e59a8a3499f8fd8 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/var-access.tcl (.../var-access.tcl) (revision 29ea21bd3f28ea7effaca6039e59a8a3499f8fd8) +++ tests/var-access.tcl (.../var-access.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -1,5 +1,5 @@ package require nx -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test namespace eval ::nx::var1 { Index: tests/varresolutiontest.tcl =================================================================== diff -u -r29ea21bd3f28ea7effaca6039e59a8a3499f8fd8 -r18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30 --- tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision 29ea21bd3f28ea7effaca6039e59a8a3499f8fd8) +++ tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision 18d4d9c1a99310c3fb9b2f2bed03e9d59fb30d30) @@ -2,7 +2,7 @@ # testing var resolution # package require nx; namespace import ::nx::* -::nx::configure defaultMethodProtection false +::nx::configure defaultMethodCallProtection false package require nx::test Test parameter count 1