Index: Makefile.in =================================================================== diff -u -r66bbafa5fb1fe5c268131d7383fe3f8591aeb518 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- Makefile.in (.../Makefile.in) (revision 66bbafa5fb1fe5c268131d7383fe3f8591aeb518) +++ Makefile.in (.../Makefile.in) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -490,6 +490,7 @@ $(TCLSH) $(src_test_dir_native)/methods.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) $(TCLSH) $(src_test_dir_native)/method-parameter.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) $(TCLSH) $(src_test_dir_native)/cget.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) + $(TCLSH) $(src_test_dir_native)/properties.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) $(TCLSH) $(src_test_dir_native)/var-access.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) $(TCLSH) $(src_test_dir_native)/varresolution.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) $(TCLSH) $(src_test_dir_native)/info-method.test -libdir $(PLATFORM_DIR) $(TESTFLAGS) Index: TODO =================================================================== diff -u -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- TODO (.../TODO) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ TODO (.../TODO) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -4110,10 +4110,76 @@ during shutdown to avoid missing slot forwarders called from destructors +nx::Class create C { + :property {b b1} + :public property {c c1} + :protected property -accessor {d d1} + + :variable foo +} + +Property reform part 1: + +- disallow protection modifiers for "properties" and + add new flag "-accessor" to "property" and "variable" + This changes definitions like + Class create C { + :property {a a1} + :public property {b b1} + :protected property {c c1} + :private property {d d1} + } + to + Class create C { + :property {a a1} + :property -accessor public {b b1} + :property -accessor protected {c c1} + :property -accessor private {d d1} + } + since "properties" are always public accessible + over the "configure" and "cget" interface, but the + accessors methods might not be public. The value of + the accessor might be also "none" (specifying explicitely + that no accessor is wanted) or "", which means: use the default. + Same holds for "variable" + +- disallow parameter option "incremental" and change it to a flag + of the property or variable. The motivation for this is due to + the fact, that "incremental" is a property of the accessor, and + not of the value. + + old: + Class create C { + :property foo:int,incremental + :variable bar:int,incremental + } + + new: + Class create C { + :property -incremental foo:int + :variable -incremental bar:int + } + +- disallow "public class property" and friends since these are not needed +- removed parameter property "noaccessor" + +- removed "nx::configure defaultPropertyCallProtection" and + method hook "__default_property_call_protection" + +- introduced "nx::configure defaultAccessor" and + method hook "__default_accessor" + +- for the time being, "defaultAccessor" is "public" for NX and XOTcl, + will be changed to "none" in NX + +- extended regression test (new file properties.test) + + ======================================================================== TODO: -- use cget per default instead of accessor methods -- default mechanism for accessor methods +- check noconfig +- Property reform part 2: better handling of per-object properties +- Property reform part 3: change defaultPropertyAccessor or nx to none - handling of method names in error messages from nsfAPI.h. The following ? {o __alloc x} {method __alloc not dispatched on valid class} Index: doc/example-scripts/container.tcl =================================================================== diff -u -re68fc7356263c35f5924f826bb3959f75bd42211 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- doc/example-scripts/container.tcl (.../container.tcl) (revision e68fc7356263c35f5924f826bb3959f75bd42211) +++ doc/example-scripts/container.tcl (.../container.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -67,7 +67,7 @@ # by the slots. # nx::Class create OrderedContainer -superclass SimpleContainer { - :property {items:0..n,incremental {}} + :property -incremental {items:0..n {}} :public method new {args} { set item [${:memberClass} create [:]::[:autoname ${:prefix}] {*}$args] Index: doc/example-scripts/rosetta-constraint-genericity.tcl =================================================================== diff -u -r5693145107c55b5f64bf0fb487aa43e0f2238f1a -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- doc/example-scripts/rosetta-constraint-genericity.tcl (.../rosetta-constraint-genericity.tcl) (revision 5693145107c55b5f64bf0fb487aa43e0f2238f1a) +++ doc/example-scripts/rosetta-constraint-genericity.tcl (.../rosetta-constraint-genericity.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -23,7 +23,7 @@ # add+ or +item remove+. # nx::Class create FoodBox { - :property item:object,type=::Eatable,0..n,incremental + :property -incremental item:object,type=::Eatable :public method print {} { set string "Foodbox contains:\n" foreach i ${:item} {append string " [$i name]\n"} Index: generic/nsf.c =================================================================== diff -u -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- generic/nsf.c (.../nsf.c) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ generic/nsf.c (.../nsf.c) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -22079,10 +22079,13 @@ ParamDefsRefCountIncr(paramDefs); /* - * Iterate over the parameter definitions to lookup the desired parameter + * Iterate over the parameter definitions to lookup the desired + * parameter. Skip positional parameters and those with NOCONFIG settings. */ for (i = 1, paramPtr = paramDefs->paramsPtr; paramPtr->name; paramPtr++, i++) { - if (*paramPtr->name != '-') continue; + if (*paramPtr->name != '-' || (paramPtr->flags & NSF_ARG_NOCONFIG)) { + continue; + } if (strcmp(nameString, paramPtr->name) == 0) { found = 1; break; Index: library/lib/nx-test.tcl =================================================================== diff -u -r67c92d72f53bd368ff0fce6555ec803e859d7300 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- library/lib/nx-test.tcl (.../nx-test.tcl) (revision 67c92d72f53bd368ff0fce6555ec803e859d7300) +++ library/lib/nx-test.tcl (.../nx-test.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -23,7 +23,7 @@ :property cmd :property {namespace ::} :property {verbose 0} - :property {expected 1} + :property -accessor public {expected 1} :property {count 1} :property msg :property setResult @@ -112,7 +112,7 @@ } :public method call {msg cmd} { - if {[:verbose]} {puts stderr "$msg: $cmd"} + if {${:verbose}} {puts stderr "$msg: $cmd"} return [::namespace eval ${:namespace} $cmd] } @@ -130,7 +130,7 @@ if {[info exists :count]} {set c ${:count}} {set c 1000} } #puts stderr "running test $c times" - if {[:verbose]} {puts stderr "running test $c times"} + if {${:verbose}} {puts stderr "running test $c times"} if {$c > 1} { set r0 [time {time {::namespace eval ${:namespace} ";"} $c}] regexp {^(-?[0-9]+) +} $r0 _ mS0 Index: library/lib/nx-traits.tcl =================================================================== diff -u -r7867a5e0adfb4cfb1d32e0e5fa2758396d06dcfc -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- library/lib/nx-traits.tcl (.../nx-traits.tcl) (revision 7867a5e0adfb4cfb1d32e0e5fa2758396d06dcfc) +++ library/lib/nx-traits.tcl (.../nx-traits.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -142,8 +142,8 @@ # nx::Class create nx::Trait { :property {package} - :property {requiredMethods:0..n,incremental ""} - :property {requiredVariables:0..n,incremental ""} + :property -incremental {requiredMethods:0..n ""} + :property -incremental {requiredVariables:0..n ""} :public method "require trait" {traitName {nameMap ""}} { # adding a trait to a trait Index: library/nx/nx.tcl =================================================================== diff -u -rdd34cd1a57fb3255f6fe638482c51cdcf3a483c8 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- library/nx/nx.tcl (.../nx.tcl) (revision dd34cd1a57fb3255f6fe638482c51cdcf3a483c8) +++ library/nx/nx.tcl (.../nx.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -209,10 +209,10 @@ # Define default method and property protection ###################################################################### ::nsf::method::create Object __default_method_call_protection args {return false} - ::nsf::method::create Object __default_property_call_protection args {return false} + ::nsf::method::create Object __default_accessor args {return public} ::nsf::method::property Object __default_method_call_protection call-protected true - ::nsf::method::property Object __default_property_call_protection call-protected true + ::nsf::method::property Object __default_accessor call-protected true ###################################################################### # Define method "method" for Class and Object @@ -280,10 +280,9 @@ # Well, class is not a method defining method either, but a modifier array set ::nsf::methodDefiningMethod { - method 1 alias 1 property 1 forward 1 class 1 + method 1 alias 1 forward 1 class 1 ::nsf::classes::nx::Class::method 1 ::nsf::classes::nx::Object::method 1 ::nsf::classes::nx::Class::alias 1 ::nsf::classes::nx::Object::alias 1 - ::nsf::classes::nx::Class::property 1 ::nsf::classes::nx::Object::property 1 ::nsf::classes::nx::Class::forward 1 ::nsf::classes::nx::Object::forward 1 } @@ -296,16 +295,21 @@ :method public {args} { if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} { error "'[lindex $args 0]' is not a method defining method" + } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} { + error "'[lindex $args 1]' is not a method defining method" } set r [: -system {*}$args] if {$r ne ""} {::nsf::method::property [self] $r call-protected false} + return $r } # method modifier "protected" :method protected {args} { if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} { error "'[lindex $args 0]' is not a method defining method" + } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} { + error "'[lindex $args 1]' is not a method defining method" } set r [: -system {*}$args] if {$r ne ""} {::nsf::method::property [self] $r call-protected true} @@ -316,14 +320,9 @@ :method private {args} { if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} { error "'[lindex $args 0]' is not a method defining method" + } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} { + error "'[lindex $args 1]' is not a method defining method" } - if {[lindex $args 0] eq "property"} { - # handle "... private property ...." - set args [linsert $args 1 -private] - } elseif {[lindex $args 0] eq "class" && [lindex $args 1] eq "property"} { - # handle "... private class property ...." - set args [linsert $args 2 -private] - } set r [: -system {*}$args] if {$r ne ""} {::nsf::method::property [self] $r call-private true} return $r @@ -933,13 +932,10 @@ if {$property in [list "required" "convert" "substdefault" "noarg" "noleadingdash"]} { if {$property eq "convert" } {set class [:requireClass ::nx::VariableSlot $class]} lappend opts -$property 1 - } elseif {$property eq "noaccessor"} { - set opt(-accessor) 0 } elseif {$property eq "noconfig"} { - set opt(-config) 0 + set opt(-config) 0 ;# TODO } elseif {$property eq "incremental"} { - set opt(-accessor) 1 - lappend opts -incremental 1 + error "parameter option incremental must not be used; use non-positional argument -incremental instead" } elseif {[string match type=* $property]} { set class [:requireClass ::nx::VariableSlot $class] set type [string range $property 5 end] @@ -978,6 +974,7 @@ {-class ""} {-initblock ""} {-private:switch} + {-incremental:switch} {-defaultopts ""} spec default:optional @@ -986,6 +983,7 @@ lassign [:parseParameterSpec -class $class -defaultopts $defaultopts $spec] \ name parameterOptions class opts + lappend opts -incremental $incremental if {[info exists default]} { lappend opts -default $default } @@ -1130,7 +1128,8 @@ {methodname} {forwardername} {defaultmethods {get assign}} - {accessor false} + {accessor public} + {incremental:boolean false} {config true} {noarg} {noleadingdash} @@ -1168,6 +1167,9 @@ # objects are created, invalidate the object parameters to reflect # the changes # + if {${:incremental} && [:info class] eq [current class]} { + error "flag incremental must not be used for this slot type" + } if {![info exists :methodname]} { set :methodname ${:name} } @@ -1293,7 +1295,6 @@ ObjectParameterSlot public method getPropertyDefinition {} { set options [:getParameterOptions -withMultiplicity true] if {[info exists :positional]} {lappend options positional} - if {!${:accessor}} {lappend options noaccessor} if {!${:config}} {lappend options noconfig} if {[info exists :default]} { return [list [:namedParameterSpec "" ${:name} $options] ${:default}] @@ -1349,13 +1350,13 @@ ::nsf::relation RelationSlot superclass ObjectParameterSlot createBootstrapVariableSlots ::nx::RelationSlot { - {accessor true} + {accessor public} {multiplicity 0..n} } RelationSlot protected method init {} { ::nsf::next - if {${:accessor}} { + if {${:accessor} ne ""} { :makeForwarder } } @@ -1567,9 +1568,9 @@ createBootstrapVariableSlots ::nx::VariableSlot { {arg} {convert false} - {incremental} + {incremental:boolean false} {multiplicity 1..1} - {accessor true} + {accessor public} {type} {settername} valuecmd @@ -1668,28 +1669,37 @@ if {[:info lookup method add] ne "::nsf::classes::nx::VariableSlot::add"} {return 1} if {[:info lookup method get] ne "::nsf::classes::nx::VariableSlot::get"} {return 1} if {[info exists :settername]} {return 1} - if {![info exists :incremental]} {return 0} + if {!${:incremental}} {return 0} #if {![:isMultivalued]} {return 0} #puts stderr "[self] ismultivalued" return 1 } ::nx::VariableSlot public method makeAccessor {} { - - if {!${:accessor}} { + + if {${:accessor} eq "none"} { #puts stderr "Do not register forwarder ${:domain} ${:name}" return 0 } + if {[:needsForwarder]} { set handle [:makeForwarder] :makeIncrementalOperations } else { set handle [:makeSetter] } - ::nsf::method::property ${:domain} \ - {*}[expr {${:per-object} ? "-per-object" : ""}] \ - $handle call-protected \ - [::nsf::dispatch ${:domain} __default_property_call_protection] + + if {${:accessor} eq "protected"} { + ::nsf::method::property ${:domain} {*}[expr {${:per-object} ? "-per-object" : ""}] \ + $handle call-protected true + set :config 0 + } elseif {${:accessor} eq "private"} { + ::nsf::method::property ${:domain} {*}[expr {${:per-object} ? "-per-object" : ""}] \ + $handle call-private true + set :config 0 + } elseif {${:accessor} ne "public"} { + error "accessor value '${:accessor}' invalid; might be one of public|protected|private or none" + } return 1 } @@ -1706,6 +1716,11 @@ } ::nx::VariableSlot protected method init {} { + #puts "VariableSlot [self] ${:incremental} && ${:accessor} && ${:multiplicity} incremental ${:incremental}" + if {${:incremental}} { + if {${:accessor} eq "none"} { set :accessor "public" } + if {![:isMultivalued]} { set :multiplicity "0..n" } + } next :makeAccessor :handleTraces @@ -1837,11 +1852,11 @@ ###################################################################### nx::Object method variable { - {-accessor:switch} + {-accessor "none"} + {-incremental:switch} {-class ""} {-initblock ""} {-nocomplain:switch} - {-private:switch} spec:parameter defaultValue:optional } { @@ -1854,19 +1869,14 @@ # - when initblock is non empty # - #puts stderr "Object variable $spec accessor $accessor nocomplain $nocomplain" + #puts stderr "Object variable $spec accessor $accessor nocomplain $nocomplain incremental $incremental" # get name and list of parameter options lassign [::nx::MetaSlot parseParameterSpec -class $class $spec] \ name parameterOptions class options array set opts $options - if {[info exists opts(-incremental)]} { - # the usage of "-incremental" implies "-accessor" - set accessor true - } - - if {$initblock eq "" && !$accessor} { + if {$initblock eq "" && $accessor eq "none" && !$incremental} { # # we can build a slot-less variable # @@ -1895,14 +1905,16 @@ } return } + # # create variable via a slot object # set slot [::nx::MetaSlot createFromParameterSpec [self] \ -per-object \ -class $class \ -initblock $initblock \ - -private=$private \ + -incremental=$incremental \ + -private=[expr {$accessor eq "private"}] \ -defaultopts [list -accessor $accessor -config false] \ $spec \ {*}[expr {[info exists defaultValue] ? [list $defaultValue] : ""}]] @@ -1920,35 +1932,43 @@ } Object method property { + {-accessor ""} + {-incremental:switch} {-class ""} {-nocomplain:switch} - {-private:switch} spec:parameter {initblock ""} } { + + if {${accessor} eq ""} { + set accessor [::nsf::dispatch [self] __default_accessor] + #puts stderr "OBJECT got default accessor ${accessor}" + } + set r [[self] ::nsf::classes::nx::Object::variable \ - -accessor=true \ + -accessor $accessor \ + -incremental=$incremental \ -class $class \ -initblock $initblock \ -nocomplain=$nocomplain \ - -private=$private \ {*}$spec] return $r } nx::Class method variable { - {-accessor:switch} - {-class ""} - {-config:switch} - {-initblock ""} - {-private:switch} - spec:parameter - defaultValue:optional - } { + {-accessor "none"} + {-incremental:switch} + {-class ""} + {-config:switch} + {-initblock ""} + spec:parameter + defaultValue:optional + } { set slot [::nx::MetaSlot createFromParameterSpec [::nsf::self] \ -class $class \ -initblock $initblock \ - -private=$private \ + -incremental=$incremental \ + -private=[expr {$accessor eq "private"}] \ -defaultopts [list -accessor $accessor -config $config] \ $spec \ {*}[expr {[info exists defaultValue] ? [list $defaultValue] : ""}]] @@ -1962,17 +1982,23 @@ } nx::Class method property { + {-accessor ""} + {-incremental:switch} {-class ""} - {-private:switch} spec:parameter {initblock ""} } { + + if {${accessor} eq ""} { + set accessor [::nsf::dispatch [self] __default_accessor] + #puts stderr "CLASS got default accessor ${accessor}" + } set r [[self] ::nsf::classes::nx::Class::variable \ - -accessor=true \ + -accessor $accessor \ + -incremental=$incremental \ -class $class \ -config=true \ -initblock $initblock \ - -private=$private \ {*}$spec] return $r } @@ -2334,23 +2360,25 @@ } # - # Set the default method protection for nx methods. This - # protection level is used per default for definitions of - # properties and setters + # Set the default method accessor handling nx properties. The configured + # value is used for creating accessors for properties in nx. # - :method defaultPropertyCallProtection {value:boolean,optional} { + :method defaultAccessor {value:optional} { if {[info exists value]} { - ::nsf::method::create Object __default_property_call_protection args [list return $value] - ::nsf::method::property Object __default_property_call_protection call-protected true + if {$value ni {"public" "protected" "private" "none"}} { + error {defaultAccessor must be "public", "protected", "private" or "none"} + } + ::nsf::method::create Object __default_accessor args [list return $value] + ::nsf::method::property Object __default_accessor call-protected true } - return [::nsf::dispatch [::nx::self] __default_property_call_protection] + return [::nsf::dispatch [::nx::self] __default_accessor] } } # # Make the default protected methods # ::nx::configure defaultMethodCallProtection true - ::nx::configure defaultPropertyCallProtection false + ::nx::configure defaultAccessor public # # Provide an ensemble-like interface to the ::nsf primitiva to Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r55d0e812c6b2d7895720b83d20addf87d0945c18 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 55d0e812c6b2d7895720b83d20addf87d0945c18) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -387,12 +387,11 @@ } ###################################################################### - # Define default property protection before calling :property + # Define default accessors for all parameters ###################################################################### - ::nsf::method::create ::xotcl::Object __default_property_call_protection args {return false} - ::nsf::method::property ::xotcl::Object __default_property_call_protection call-protected true + ::nsf::method::create Object __default_accessor args {return public} + ::nsf::method::property Object __default_accessor call-protected true - # # Use parameter definition from nx # (same with classInfo parameter, see below) @@ -959,7 +958,7 @@ ::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::nx::VariableSlot { :property multivalued { :public method assign {object property value} { - set mClass [expr {$value?"0..n":"1..1"}] + set mClass [expr {$value ? "0..n" : "1..1"}] $object incremental $value $object multiplicity $mClass } Index: tests/cget.test =================================================================== diff -u -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/cget.test (.../cget.test) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ tests/cget.test (.../cget.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -125,7 +125,7 @@ nx::Class create Person { :property famnam:required - :property {age:integer,required 0} + :property -accessor public {age:integer,required 0} :property {friends:0..n ""} :property sex @@ -145,7 +145,7 @@ # # read properties - # - built-in getter + # - built-in accessor # - cget # - dispatch of cget method with full path # - cget via slot method @@ -156,7 +156,7 @@ # # write properties: - # - built-in setter + # - built-in accessor # - configure # - configure via slot method ? {p1 age 27} 27 Index: tests/destroy.test =================================================================== diff -u -rede10bf0265c3943458771665317aa0c12971900 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/destroy.test (.../destroy.test) (revision ede10bf0265c3943458771665317aa0c12971900) +++ tests/destroy.test (.../destroy.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -798,12 +798,12 @@ # The following tests the deletion order triggering implict # deletions. This caused a crash in nsf 2.0b2. # - package req nx::serializer nx::Test case class-object-property { + Class create C { - :class property x + :class property -accessor public x :property a:int } Index: tests/info-method.test =================================================================== diff -u -r8f14fdaf0de110b56e3132a178267f3372a32235 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/info-method.test (.../info-method.test) (revision 8f14fdaf0de110b56e3132a178267f3372a32235) +++ tests/info-method.test (.../info-method.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -73,8 +73,8 @@ :class forward add1 expr 1 + :class forward fpo ::o - :property s - :class property spo + :property -accessor public s + :class property -accessor public spo :alias a ::set :class alias apo ::puts @@ -374,10 +374,14 @@ ? {o method foo {} {return o.foo}} "::o::foo" ? {o alias is ::nsf::is} "::o::is" + #? {o property x} {variable definition for 'x' (without value and accessor) is useless} ? {o property x} "::o::x" + ? {o property -accessor public x} "::o::x" ? {lsort [o info methods]} "foo is x" + #? {o property A} {variable definition for 'A' (without value and accessor) is useless} ? {o property A} ::o::A + ? {o property -accessor public A} ::o::A ? {o forward fwd ::set} ::o::fwd ? {lsort [o info methods]} "A foo fwd is x" @@ -464,10 +468,10 @@ nx::Class create D -superclass C { :property {b 2} :property c - :class property a2 + :class property -accessor public {a2 ""} :method "sub foo" args {;} :create d1 { - :property a3 + :property -accessor public {a3 ""} } } @@ -494,7 +498,7 @@ nx::Class create D -superclass C { :property {b 2} :property c - :class property a2 + :class property -accessor public a2 :method "sub foo" args {;} } @@ -689,7 +693,7 @@ nx::Class create D -superclass C { :property {b 2} :property c - :class property a2 + :class property -accessor public a2 :method "sub foo" args {;} } Index: tests/methods.test =================================================================== diff -u -re2c9315e50a9d90f4855c1c9c12662364c0ab370 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/methods.test (.../methods.test) (revision e2c9315e50a9d90f4855c1c9c12662364c0ab370) +++ tests/methods.test (.../methods.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -18,8 +18,8 @@ # setter :property plain_setter - :public property public_setter - :protected property protected_setter + :property -accessor public public_setter + :property -accessor protected protected_setter # alias :alias plain_alias [C info method registrationhandle plain_method] @@ -33,9 +33,11 @@ :class forward plain_object_forward %self plain_object_method :public class forward public_object_forward %self public_object_method :protected class forward protected_object_forward %self protected_object_method - :class property plain_object_setter - :public class property public_object_setter - :protected class property protected_object_setter + + :class property {plain_object_setter ""} + :class property -accessor public {public_object_setter ""} + :class property -accessor protected {protected_object_setter ""} + :class alias plain_object_alias [:class info method registrationhandle plain_object_method] :public class alias public_object_alias [:class info method registrationhandle public_object_method] :protected class alias protected_object_alias [:class info method registrationhandle protected_object_method] @@ -52,20 +54,20 @@ :protected forward protected_object_forward %self protected_object_method # setter - :property plain_object_setter - :public property public_object_setter - :protected property protected_object_setter + :property {plain_object_setter ""} + :property -accessor public {public_object_setter ""} + :property -accessor protected protected_object_setter # alias :alias plain_object_alias [:info method registrationhandle plain_object_method] :public alias public_object_alias [:info method registrationhandle public_object_method] :protected alias protected_object_alias [:info method registrationhandle protected_object_method] } -C public property s0 -C protected property s1 +C property -accessor public s0 +C property -accessor protected s1 ? {c1 s0 0} 0 ? {::nsf::dispatch c1 s1 1} 1 -C class property s3 +C class property -accessor public {s3 ""} ? {C s3 3} 3 # create a fresh object (different from c1) @@ -88,7 +90,8 @@ # class level setter nx::Test case class-level-setter { - ? {c2 plain_setter 1} "1" + #? {c2 plain_setter 1} {::c2: unable to dispatch method 'plain_setter'} + ? {c2 plain_setter 1} 1 ? {c2 public_setter 2} "2" ? {catch {c2 protected_setter 3}} 1 ? {::nsf::dispatch c2 protected_setter 4} "4" @@ -122,6 +125,7 @@ # class level setter nx::Test case class-object-level-setter { + #? {C plain_object_setter 1} {method 'plain_object_setter' unknown for ::C; consider '::C create plain_object_setter 1' instead of '::C plain_object_setter 1'} ? {C plain_object_setter 1} "1" ? {C public_object_setter 2} "2" ? {catch {C protected_object_setter 3}} 1 @@ -156,6 +160,7 @@ # object level setter nx::Test case object-level-setter { + #? {c1 plain_object_setter 1} {::c1: unable to dispatch method 'plain_object_setter'} ? {c1 plain_object_setter 1} "1" ? {c1 public_object_setter 2} "2" ? {catch {c1 protected_object_setter 3}} 1 @@ -169,8 +174,13 @@ ? {catch {c1 protected_object_alias}} 1 ? {::nsf::dispatch c1 protected_object_alias} "protected_object_alias" + #? {lsort [c1 info methods]} \ + "plain_object_alias plain_object_forward plain_object_method public_object_alias public_object_forward public_object_method public_object_setter" ? {lsort [c1 info methods]} \ "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter" + + #? {lsort [C class info methods]} \ + "plain_object_alias plain_object_forward plain_object_method public_object_alias public_object_forward public_object_method public_object_setter s3" ? {lsort [C class info methods]} \ "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter s3" } @@ -252,46 +262,48 @@ nx::Test case property-method { nx::Class create C { - set x [:property a] + set x [:property -accessor public a] ? [list set _ $x] "::nsf::classes::C::a" # property with default :property {b b1} - :public property {c c1} - :protected property {d d1} + :property -accessor public {c c1} + :property -accessor protected {d d1} - set X [:class property A] + set X [:class property -accessor public A] ? [list set _ $X] "::C::A" # class property with default :class property {B B2} - :public class property {C C2} - :protected class property {D D2} + :class property -accessor public {C C2} + :class property -accessor protected {D D2} } C create c1 -a 1 ? {c1 a} 1 - ? {c1 b} b1 - ? {c1 c} c1 + ? {c1 cget -b} b1 + ? {c1 cget -c} c1 ? {c1 d} "::c1: unable to dispatch method 'd'" ? {C A 2} 2 ? {C A} 2 + #? {C B} {method 'B' unknown for ::C; consider '::C create B ' instead of '::C B '} ? {C B} B2 ? {C C} C2 ? {C D} "method 'D' unknown for ::C; consider '::C create D ' instead of '::C D '" nx::Object create o { - set x [:property a] + set x [:property -accessor public a] ? [list set _ $x] "::o::a" # property with default :property {b b1} - :public property {c c1} - :protected property {d d1} + :property -accessor public {c c1} + :property -accessor protected {d d1} } ? {o a 2} 2 + #? {o b} {::o: unable to dispatch method 'b'} ? {o b} b1 ? {o c} c1 ? {o d} "::o: unable to dispatch method 'd'" @@ -330,8 +342,8 @@ package req nx::serializer nx::Test case class-object-property { nx::Class create C { - :class property x - :property a:int + :class property -accessor public x + :property -accessor public a:int :create c1 } ? {C x 1} 1 @@ -400,7 +412,7 @@ {method 'object' unknown for ::C; consider '::C create object method bar x {return $x}' instead of '::C object method bar x {return $x}'} #? {C public class object method bar {x} {return $x}} "'object' not allowed to be modified by 'class'" ? {C public class object method bar {x} {return $x}} \ - {unable to dispatch sub-method "object" of ::C class; valid are: class alias, class delete method, class delete property, class delete variable, class filter, class filterguard, class forward, class info children, class info class, class info filter guard, class info filter methods, class info has mixin, class info has namespace, class info has type, class info info, class info is, class info lookup filter, class info lookup method, class info lookup methods, class info lookup slots, class info method, class info methods, class info mixin classes, class info mixin guard, class info name, class info parent, class info precedence, class info properties, class info slot definition, class info slot names, class info slot objects, class info vars, class method, class mixin, class mixinguard, class property, class variable} + {'object' is not a method defining method} } # @@ -410,7 +422,7 @@ nx::Object create o { # property defines a setter, we need a current object - :property {a v} + :property -accessor public {a v} # the other methods don't require them as strong :forward b ::o2 bar :method foo {} {return [nx::self]} @@ -536,8 +548,8 @@ # nx::Test case delete-per-object { nx::Object create o1 { - :property a1 - :property a2 + :property -accessor public a1 + :property -accessor public a2 :public method foo {} {return [namespace current]-[namespace which info]} :public method "info foo" {} {return [namespace current]-[namespace which info]} :public method "info bar foo" {} {return [namespace current]-[namespace which info]} @@ -582,11 +594,11 @@ # nx::Test case delete-per-object-on-class { nx::Class create C { - :class property a1 + :class property -accessor public a1 :public class method foo {} {return [namespace current]-[namespace which info]} :public class method "info foo" {} {return [namespace current]-[namespace which info]} :public class method "info bar foo" {} {return [namespace current]-[namespace which info]} - :property a2 + :property -accessor public a2 } ? {C class info methods -path} "{info foo} {info bar foo} foo a1" @@ -621,7 +633,7 @@ # nx::Test case delete-class-level-method { nx::Class create C { - :property a1 + :property -accessor public a1 :public method foo {} {return [namespace current]-[namespace which info]} :public method "info foo" {} {return [namespace current]-[namespace which info]} :public method "info bar foo" {} {return [namespace current]-[namespace which info]} Index: tests/object-system.test =================================================================== diff -u -r5c37eb1cd2b674337c60deeef1ecef4b663fa5ce -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/object-system.test (.../object-system.test) (revision 5c37eb1cd2b674337c60deeef1ecef4b663fa5ce) +++ tests/object-system.test (.../object-system.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -11,8 +11,8 @@ set r [uplevel $cmd] if {$msg eq ""} {set msg $cmd} if {$r ne $expected} { - puts stderr "ERROR $msg returned '$r' ne '$expected'" - error "FAILED $msg returned '$r' ne '$expected'" + #puts stderr "ERROR $msg returned '$r' ne '$expected'" + error "FAILED $msg returned\n'$r' ne\n'$expected'" } else { puts stderr "OK $msg" } @@ -215,7 +215,7 @@ ? {X info parameter definition x} {{-x 1}} ? {X info parameter definition y} {{-y 2}} ? {X info properties} {{x 1} {y 2}} -? {X info properties -closure *a*} {volatile:alias,noarg,noaccessor class:class,alias,method=::nsf::methods::object::class,noaccessor} +? {X info properties -closure *a*} {volatile:alias,noarg class:class,alias,method=::nsf::methods::object::class} # actually, we want c1 to test below the recreation of c1 in another # object system Index: tests/parameters.test =================================================================== diff -u -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/parameters.test (.../parameters.test) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ tests/parameters.test (.../parameters.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -26,7 +26,7 @@ ? {::nsf::method::alias C foo ::set 1} \ {invalid argument '1', maybe too many arguments; should be "::nsf::method::alias object ?-per-object? methodName ?-frame method|object|default? cmdName"} - ? {C eval {:property x -class D}} {invalid argument 'D', maybe too many arguments; should be "::C property ?-class value? ?-private? spec ?initblock?"} "Test whether the colon prefix is suppressed" + ? {C eval {:property x -class D}} {invalid argument 'D', maybe too many arguments; should be "::C property ?-accessor value? ?-incremental? ?-class value? spec ?initblock?"} "Test whether the colon prefix is suppressed" } ####################################################### @@ -488,11 +488,14 @@ ? {Foo create foo -ints {1 a 2}} {invalid value in "1 a 2": expected integer but got "a" for parameter "-ints"} # make slot incremental - Foo::slot::ints eval { - set :incremental 1 - :reconfigure - } + Foo property -incremental ints:integer,1..* + # TODO? the following does not work. Should we revive it? + #Foo::slot::ints eval { + # set :incremental 1 + # :reconfigure + #} + Foo create foo -ints {1 2} ? {foo ints add 0} "0 1 2" ? {foo ints add a} {expected integer but got "a" for parameter "value"} @@ -925,7 +928,7 @@ :property {s2:substdefault,substdefault "[current]"} # substdefault with incremental - :property {s3:substdefault,incremental "[current]"} + :property -incremental {s3:substdefault "[current]"} } Bar create ::b @@ -1251,8 +1254,8 @@ nx::Test case slot-nosetter { nx::Class create C { :property a - :property b:integer,noaccessor - :property {c:noaccessor ""} + :property -accessor none b:integer + :property -accessor none {c ""} } ? {C create c1 -a 1 -b 2} ::c1 @@ -1831,7 +1834,9 @@ nx::Class create C { :property a1 :create c1 { +puts stderr ====1 :property a2 +puts stderr ====2 } } @@ -2091,13 +2096,13 @@ {value '11' of parameter value not between 1 and 10} # valid value - ? [list [self] variable -nocomplain r1:range,arg=1-10 5] "" + ? [list [self] variable -nocomplain r1:range,arg=1-10 5] "" ? [list [self] property -nocomplain [list r2:range,arg=1-10 5]] \ {::enterprise::r2} # testing incremental - ? [list [self] variable -nocomplain i:int,0..*,incremental {}] "::enterprise::i" - ? [list [self] property -nocomplain j:int,0..*,incremental {}] "::enterprise::j" + ? [list [self] variable -incremental -nocomplain i:int,0..* {}] "::enterprise::i" + ? [list [self] property -incremental -nocomplain j:int,0..* {}] "::enterprise::j" :i add 1 :j add 1 ? [list [self] i] "1" @@ -2133,7 +2138,9 @@ nx::Class create C { # define 2 class-level variables, one via variable, one via property + puts stderr ====1 :variable v v0 + puts stderr ====2 :property {a a0} # create an instance @@ -2155,7 +2162,7 @@ ? {C info parameter syntax a} "?-a value?" ? {C info parameter definition v} "" - ? {C info slot definition v} "{v:noaccessor,noconfig v0}" + ? {C info slot definition v} "{v:noconfig v0}" ? {C info parameter list v} "" ? {C info parameter syntax v} "" @@ -2335,12 +2342,12 @@ # "v" does show up in "info slot ..." ? {C info slot objects} "::C::slot::v" - ? {C info slot definition} "{v:noaccessor,noconfig 100}" + ? {C info slot definition} "{v:noconfig 100}" nx::Class create D { :property {p0 200} - :property {p1:noaccessor 201} - :property {p2:noaccessor,noconfig 202} + :property -accessor none {p1 201} + :property -accessor none {p2:noconfig 202} :property {p3:noconfig 203} } @@ -2353,8 +2360,8 @@ # all properties show up in "info slot" ? {D info slot objects} "::D::slot::p0 ::D::slot::p1 ::D::slot::p2 ::D::slot::p3" - ? {D info slot definition} "{p0 200} {p1:noaccessor 201} {p2:noaccessor,noconfig 202} {p3:noconfig 203}" - ? {D info properties} "{p0 200} {p1:noaccessor 201} {p2:noaccessor,noconfig 202} {p3:noconfig 203}" + ? {D info slot definition} "{p0 200} {p1 201} {p2:noconfig 202} {p3:noconfig 203}" + ? {D info properties} "{p0 200} {p1 201} {p2:noconfig 202} {p3:noconfig 203}" } @@ -2368,28 +2375,29 @@ :variable v0 100 # In case we require an accessor or e.g. incremental, slot objects # are created; incremental implies accessor - :variable -accessor v1 100 - :variable v2:incremental 100 + :variable -accessor public v1 100 + :variable -incremental v2 100 } # only the variables with slots show up in "info slot ..." ? {o1 info slot objects} "::o1::per-object-slot::v2 ::o1::per-object-slot::v1" - ? {o1 info slot definition} "{v2:noconfig 100} {v1:noconfig 100}" + ? {o1 info slot definition} "{v2:0..n,noconfig 100} {v1:noconfig 100}" nx::Object create o2 { :property {p0 200} - :property {p1:noaccessor 201} - :property {p2:noaccessor,noconfig 202} + :property -accessor none {p1 201} + :property -accessor none {p2:noconfig 202} :property {p3:noconfig 203} } # "p1" and "p2" do NOT show up in "info methods" ? {o2 info methods} "p0 p3" - # all properties show up in "info slot" - ? {o2 info slot objects} "::o2::per-object-slot::p0 ::o2::per-object-slot::p1 ::o2::per-object-slot::p2 ::o2::per-object-slot::p3" - ? {o2 info slot definition} "{p0:noconfig 200} {p1:noaccessor,noconfig 201} {p2:noaccessor,noconfig 202} {p3:noconfig 203}" - ? {o2 info properties} "{p0:noconfig 200} {p1:noaccessor,noconfig 201} {p2:noaccessor,noconfig 202} {p3:noconfig 203}" + # all properties with slots show up in "info slot" + # TODO: object slots will change when we allow true object properties + ? {o2 info slot objects} "::o2::per-object-slot::p0 ::o2::per-object-slot::p3" + ? {o2 info slot definition} "{p0:noconfig 200} {p3:noconfig 203}" + ? {o2 info properties} "{p0:noconfig 200} {p3:noconfig 203}" } @@ -2529,13 +2537,13 @@ # -# Test forwarding to slot vs. noaccessor +# Test forwarding to slot vs. accessor none # nx::Test case forward-to-assign { set ::slotcalls 0 ? {nx::Class create Foo { - :property bar:noaccessor { + :property -accessor none bar { :public method assign { object property value } { incr ::slotcalls 1 nsf::var::set $object $property $value @@ -2549,7 +2557,7 @@ # test cases for default nx::Class create Foo { - :property {baz:noaccessor 1} { + :property -accessor none {baz 1} { :public method assign { object property value } { incr ::slotcalls 1 nsf::var::set $object $property $value Index: tests/protected.test =================================================================== diff -u -r26480a59b14cf250904da0cdc7d895f21b0ed5fd -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/protected.test (.../protected.test) (revision 26480a59b14cf250904da0cdc7d895f21b0ed5fd) +++ tests/protected.test (.../protected.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -689,10 +689,10 @@ # nx::Test case protected-priv-class-property { nx::Class create C { - :public property {a a1} - :protected property {b b1} - :private property {c c1} - :private property {d:integer 1} + :property -accessor public {a a1} + :property -accessor protected {b b1} + :property -accessor private {c c1} + :property -accessor private {d:integer 1} :public method foo {p} {return [: $p]} :public method bar {p} {return [: -local $p]} :public method baz {p v} {return [: -local $p $v]} @@ -735,7 +735,7 @@ # The values of the private properties do not conflict. # nx::Class create D -superclass C { - :private property {c c1d} + :property -accessor private {c c1d} :public method bard {p} {return [: -local $p]} :create d1 { :property {c c1o} @@ -754,10 +754,10 @@ # The values of the private properties do not conflict. # nx::Class create D -superclass C { - :public property {c c1d} + :property -accessor public {c c1d} :public method bard {p} {return [: -local $p]} :create d1 { - :private property {c c1o} + :property -accessor private {c c1o} :public method bard1 {p} {return [: -local $p]} } } @@ -777,11 +777,11 @@ :property {x c} } nx::Class create D -superclass C { - :private property {x d} + :property -accessor private {x d} :public method bar-d {p} {return [: -local $p]} } nx::Class create E -superclass D { - :private property {x e} + :property -accessor private {x e} :public method bar-e {p} {return [: -local $p]} } @@ -796,10 +796,10 @@ # nx::Test case protected-priv-object-property { nx::Object create o { - :public property {a a1} - :protected property {b b1} - :private property {c c1} - :private property {d:integer 1} + :property -accessor public {a a1} + :property -accessor protected {b b1} + :property -accessor private {c c1} + :property -accessor private {d:integer 1} :public method foo {p} {return [: $p]} :public method bar {p} {return [: -local $p]} :public method baz {p v} {return [: -local $p $v]} @@ -832,10 +832,10 @@ # nx::Test case protected-priv-class-object-property { nx::Class create C { - :public class property {a a1} - :protected class property {b b1} - :private class property {c c1} - :private class property {d:integer 1} + :class property -accessor public {a a1} + :class property -accessor protected {b b1} + :class property -accessor private {c c1} + :class property -accessor private {d:integer 1} :public class method foo {p} {return [: $p]} :public class method bar {p} {return [: -local $p]} :public class method baz {p v} {return [: -local $p $v]} @@ -861,4 +861,9 @@ ? {C baz d 2} {2} ? {C bar d} {2} ? {C baz d x} {expected integer but got "x" for parameter "value"} + + + ? {C public class property {d:integer 1}} {'property' is not a method defining method} + ? {C protected class property {d:integer 1}} {'property' is not a method defining method} + ? {C private class property {d:integer 1}} {'property' is not a method defining method} } \ No newline at end of file Index: tests/submethods.test =================================================================== diff -u -r5ce68a42506fcc981cea2431afa1b09b476e667a -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 --- tests/submethods.test (.../submethods.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) +++ tests/submethods.test (.../submethods.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) @@ -364,11 +364,7 @@ } } -# :public method intercept {} { next } -# -> TODO: wrong # args: should be ":FOO" ... trim the colon! - - nx::Test case submethods-and-filters { # # submethods as filters? @@ -496,15 +492,14 @@ # filter-local argv. Class create Z { - :class property msg + :class property -accessor public msg :method intercept args { [current class] eval [list set :msg [list [current methodpath] \ [current calledmethod] \ [current calledclass] \ [current nextmethod]]] next } - } set c [Z new]