Index: TODO =================================================================== diff -u -rf6a37db73b3ab59faf0bd0486c19548655f98bfe -r46c536260f793729feb23fff02cc15e3867ae0ee --- TODO (.../TODO) (revision f6a37db73b3ab59faf0bd0486c19548655f98bfe) +++ TODO (.../TODO) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -3073,23 +3073,27 @@ - nsf.c: improve performance (branch prediction) by using likely/unlikely macros for gcc -TODO: - - more regression tests for incremental + variable/attribute +- nx.tcl: + * added support for "variable" on the class-level + * added flag "noconfig" to object parameter options + * parameters with "noconfig" are omitted in + "info parameter syntax" and "info parameter list" + * used switches for all configurable boolean options for + "variable" and "attribute" + * regularized the interface of "variable" and "attribute" + * extended regression test - - placement of switched and parameters: - currently we have: - /obj/ attribute ?-incremental? ?-nocomplain? spec ?-class value? ?initblock? - /obj/ variable ?-class value? ?-initblock value? ?-accessor boolean? ?-array? ?-incremental? ?-nocomplain? spec ?value? - /cls/ attribute ?-incremental? spec ?-class value? ?initblock? - /cls/ variable ?-class value? ?-incremental? ?-initblock value? ?-objectparameter value? ?-accessor value? spec ?default? +TODO: + - add "delete variable" analogous to "delete attribute" + - interface of "variable" and "attribute": + * add switch -array for "variable"? + * should we switch from "-class" to "-slotclass"? + * should we change interface for default value in attribute? + probably not, same interface is used in methodparameters as well - should we switch from "-class" to "-slotclass"? - - - should we change interface for default value in attribute? - probably not, same interface is used in methodparameters as well - - Should we leave "variable" and "attribute" as it ist? - options: + - Should we leave "variable" and "attribute" as it is, or + switch the names to something better? Some options: (a) leave it as it is (b) use "property" instead of "attribute" ("a property is a variable with accessors"), @@ -3102,12 +3106,6 @@ (e) others? - call user defined setter in object parameters? - - maybe use (position == -1) instead of (objectparameter == false) to save common vars - - cleanup variable/attribute - - testing variable/attribute - - maybe change default - createBootstrapAttributeSlots ::nx::Attribute {accessor true} -> false - #::nsf::var::exists ?-array? object varName #::nsf::var::import object ?arg ...? #::nsf::var::set ?-array? object varName ?value? Index: generic/nsf.c =================================================================== diff -u -rf6a37db73b3ab59faf0bd0486c19548655f98bfe -r46c536260f793729feb23fff02cc15e3867ae0ee --- generic/nsf.c (.../nsf.c) (revision f6a37db73b3ab59faf0bd0486c19548655f98bfe) +++ generic/nsf.c (.../nsf.c) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -7796,6 +7796,8 @@ ParamDefsFormatOption(nameStringObj, "forward", &colonWritten, &first); } else if ((pPtr->flags & NSF_ARG_NOARG)) { ParamDefsFormatOption(nameStringObj, "noarg", &colonWritten, &first); + } else if ((pPtr->flags & NSF_ARG_NOCONFIG)) { + ParamDefsFormatOption(nameStringObj, "noconfig", &colonWritten, &first); } innerListObj = Tcl_NewListObj(0, NULL); @@ -7832,7 +7834,9 @@ Nsf_Param CONST *pPtr; for (pPtr = paramsPtr; pPtr->name; pPtr++) { - Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(pPtr->name, -1)); + if ((pPtr->flags & NSF_ARG_NOCONFIG) == 0) { + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(pPtr->name, -1)); + } } return listObj; } @@ -7963,6 +7967,13 @@ Nsf_Param CONST *pPtr; for (pPtr = paramPtr; pPtr->name; pPtr++) { + + if ((pPtr->flags & NSF_ARG_NOCONFIG)) { + /* + * Don't output non-configurable parameters + */ + continue; + } if (pPtr != paramPtr) { /* * Don't output non-consuming parameters (i.e. positional, and no args) @@ -10102,6 +10113,9 @@ paramPtr->flags |= NSF_ARG_NOARG; paramPtr->nrArgs = 0; + } else if (strncmp(option, "noconfig", 8) == 0) { + paramPtr->flags |= NSF_ARG_NOCONFIG; + } else if (strncmp(option, "args", 4) == 0) { if ((paramPtr->flags & NSF_ARG_ALIAS) == 0) { return NsfPrintError(interp, "option \"args\" only allowed for parameter type \"alias\""); @@ -10244,7 +10258,9 @@ return NsfPrintError(interp, "Parameter option '%s' not allowed", option); } - if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) == (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) { + if ((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) && (paramPtr->flags & NSF_ARG_NOCONFIG)) { + return NsfPrintError(interp, "Option 'noconfig' cannot used together with this type of object parameter"); + } else if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) == (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) { return NsfPrintError(interp, "Parameter types 'alias' and 'forward' can be not used together"); } else if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_INITCMD)) == (NSF_ARG_ALIAS|NSF_ARG_INITCMD)) { return NsfPrintError(interp, "Parameter types 'alias' and 'initcmd' can be not used together"); @@ -14766,7 +14782,8 @@ */ for (nppPtr = pPtr; nppPtr->name && *nppPtr->name == '-'; nppPtr ++) { if (nppPtr->nrArgs > 0) continue; - if (ch1 == nppPtr->name[1] + if ((nppPtr->flags & NSF_ARG_NOCONFIG) == 0 + && ch1 == nppPtr->name[1] && strncmp(argument, nppPtr->name, equalOffset) == 0 && *(nppPtr->name+equalOffset) == '\0') { found = 1; @@ -14779,7 +14796,8 @@ * the parameter definitions. */ for (nppPtr = pPtr; nppPtr->name && *nppPtr->name == '-'; nppPtr ++) { - if (ch1 == nppPtr->name[1] + if ((nppPtr->flags & NSF_ARG_NOCONFIG) == 0 + && ch1 == nppPtr->name[1] && strcmp(argument, nppPtr->name) == 0) { found = 1; break; @@ -18974,12 +18992,11 @@ int oc = 0; /* - Restore the variable frame context as found at the original call site of - configure(). Note that we do not have to revert this context change - when leaving this configure() context because a surrounding - [uplevel] will correct the callstack context for us ... + * Restore the variable frame context as found at the original call + * site of configure(). Note that we do not have to revert this + * context change when leaving this configure() context because a + * surrounding [uplevel] will correct the callstack context for us ... */ - if (uplevelVarFramePtr) { Tcl_Interp_varFramePtr(interp) = uplevelVarFramePtr; } Index: generic/nsfInt.h =================================================================== diff -u -rf6a37db73b3ab59faf0bd0486c19548655f98bfe -r46c536260f793729feb23fff02cc15e3867ae0ee --- generic/nsfInt.h (.../nsfInt.h) (revision f6a37db73b3ab59faf0bd0486c19548655f98bfe) +++ generic/nsfInt.h (.../nsfInt.h) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -387,12 +387,13 @@ #define NSF_ARG_REQUIRED 0x000001 #define NSF_ARG_MULTIVALUED 0x000002 #define NSF_ARG_NOARG 0x000004 -#define NSF_ARG_CURRENTLY_UNKNOWN 0x000008 -#define NSF_ARG_SUBST_DEFAULT 0x000010 -#define NSF_ARG_ALLOW_EMPTY 0x000020 -#define NSF_ARG_INITCMD 0x000040 -#define NSF_ARG_ALIAS 0x000080 -#define NSF_ARG_FORWARD 0x000100 +#define NSF_ARG_NOCONFIG 0x000008 +#define NSF_ARG_CURRENTLY_UNKNOWN 0x000010 +#define NSF_ARG_SUBST_DEFAULT 0x000020 +#define NSF_ARG_ALLOW_EMPTY 0x000040 +#define NSF_ARG_INITCMD 0x000080 +#define NSF_ARG_ALIAS 0x000100 +#define NSF_ARG_FORWARD 0x000200 #define NSF_ARG_SWITCH 0x000400 #define NSF_ARG_BASECLASS 0x000800 #define NSF_ARG_METACLASS 0x001000 @@ -405,11 +406,12 @@ #define NSF_ARG_UNNAMED 0x080000 #define NSF_ARG_IS_RETURNVALUE 0x100000 + /* method invocations */ #define NSF_ARG_METHOD_INVOCATION (NSF_ARG_ALIAS|NSF_ARG_FORWARD|NSF_ARG_INITCMD) /* Disallowed parameter options */ -#define NSF_DISALLOWED_ARG_METHOD_PARAMETER NSF_ARG_METHOD_INVOCATION +#define NSF_DISALLOWED_ARG_METHOD_PARAMETER (NSF_ARG_METHOD_INVOCATION|NSF_ARG_NOCONFIG) #define NSF_DISALLOWED_ARG_SETTER (NSF_ARG_SWITCH|NSF_ARG_SUBST_DEFAULT|NSF_DISALLOWED_ARG_METHOD_PARAMETER) #define NSF_DISALLOWED_ARG_OBJECT_PARAMETER (NSF_ARG_SWITCH) #define NSF_DISALLOWED_ARG_VALUECHECK (NSF_ARG_SUBST_DEFAULT|NSF_ARG_METHOD_INVOCATION|NSF_ARG_SWITCH|NSF_ARG_CURRENTLY_UNKNOWN) Index: library/nx/nx.tcl =================================================================== diff -u -r9c636251d106b1728258076165dd19e8af36b2c1 -r46c536260f793729feb23fff02cc15e3867ae0ee --- library/nx/nx.tcl (.../nx.tcl) (revision 9c636251d106b1728258076165dd19e8af36b2c1) +++ library/nx/nx.tcl (.../nx.tcl) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -864,7 +864,7 @@ # set for every bootstrap attribute slot the position 0 # ::nsf::var::set $slotObj position 0 - ::nsf::var::set $slotObj objectparameter 1 + ::nsf::var::set $slotObj configparameter 1 } #puts stderr "Bootstrapslot for $class calls invalidateobjectparameter" @@ -935,7 +935,7 @@ {forwardername} {defaultmethods {get assign}} {accessor false} - {objectparameter true} + {configparameter true} {noarg} {disposition alias} {required false} @@ -1027,7 +1027,7 @@ ObjectParameterSlot protected method getParameterOptions { {-withMultiplicity 0} - {-withSubstdefault 0} + {-forObjectParameter 0} } { # # Obtain a list of parameter options from slot object @@ -1044,8 +1044,10 @@ } elseif {[info exists :positional] && ${:positional}} { lappend options optional } - if {$withSubstdefault && [info exists :substdefault] && ${:substdefault}} { - lappend options substdefault + if {$forObjectParameter} { + if {[info exists :substdefault] && ${:substdefault}} { + lappend options substdefault + } } if {[info exists :noarg] && ${:noarg}} {lappend options noarg} if {$withMultiplicity && [info exists :multiplicity] && ${:multiplicity} ne "1..1"} { @@ -1061,7 +1063,7 @@ # if {![info exists :parameterSpec]} { set prefix [expr {[info exists :positional] && ${:positional} ? "" : "-"}] - set options [:getParameterOptions -withMultiplicity true -withSubstdefault true] + set options [:getParameterOptions -withMultiplicity true -forObjectParameter true] if {[info exists :initcmd]} { lappend options initcmd set :parameterSpec [list [:namedParameterSpec $prefix ${:name} $options] ${:initcmd}] @@ -1102,11 +1104,7 @@ # ensure partial ordering and avoid sorting. # foreach slot [nsf::object::dispatch [self] ::nsf::methods::class::info::slots -closure -type ::nx::Slot] { - if {[::nsf::var::exists $slot objectparameter] && [::nsf::var::set $slot objectparameter]} { - lappend defs([$slot position]) [$slot getParameterSpec] - } else { - #puts stderr "== no objectparameter for $slot !" - } + lappend defs([$slot position]) [$slot getParameterSpec] } # # Fold the per-position lists into a common list @@ -1378,7 +1376,7 @@ ::nx::Attribute protected method getParameterOptions { {-withMultiplicity 0} - {-withSubstdefault 0} + {-forObjectParameter 0} } { set options "" if {[info exists :type]} { @@ -1407,8 +1405,13 @@ if {$withMultiplicity && [info exists :multiplicity] && ${:multiplicity} ne "1..1"} { lappend options ${:multiplicity} } - if {$withSubstdefault && [info exists :substdefault] && ${:substdefault}} { - lappend options substdefault + if {$forObjectParameter} { + if {[info exists :substdefault] && ${:substdefault}} { + lappend options substdefault + } + if {[info exists :configparameter] && !${:configparameter}} { + lappend options noconfig + } } #puts stderr "*** getParameterOptions [self] returns '$options'" return $options @@ -1588,41 +1591,19 @@ # Define method "attribute" for convenience ###################################################################### - # Class method attribute {spec {-class ""} {initblock ""}} { - # set r [::nx::MetaSlot createFromParameterSpec [::nsf::self] \ - # -class $class -initblock $initblock {*}$spec] - # if {$r ne ""} { - # set o [::nsf::self] - # ::nsf::method::property $o $r call-protected \ - # [::nsf::object::dispatch $o __default_attribute_call_protection] - # return $r - # } - # } - - # Object method attribute {spec {-class ""} {initblock ""}} { - # set r [::nx::MetaSlot createFromParameterSpec [::nsf::self] \ - # -class $class -per-object -initblock $initblock {*}$spec] - # if {$r ne ""} { - # set o [::nsf::self] - # ::nsf::method::property $o -per-object $r call-protected \ - # [::nsf::object::dispatch $o __default_attribute_call_protection] - # } - # return $r - # } - nx::Object method variable { + {-accessor:switch} {-class ""} - {-initblock ""} - {-accessor:boolean false} - {-array:switch} {-incremental:switch} + {-initblock ""} {-nocomplain:switch} spec value:optional } { # - # when do we need a slot - # currently: + # This method creates sometimes a slot, sometimes not + # (optimization). We need a slot currently in the following + # situations: # - when accessors are needed # (serializer uses slot object to create accessors) # in general: @@ -1632,12 +1613,13 @@ #puts stderr "Object variable $spec accessor $accessor nocomplain $nocomplain" if {$incremental} { - # incremental implies accessor + # the usage of "-incremental" implies "-accessor" set accessor true append initblock { set :incremental 1 } } + if {$initblock eq "" && !$accessor} { # get name an list of parameter options lassign [::nx::MetaSlot parseParameterSpec -class $class $spec] \ @@ -1663,7 +1645,7 @@ -per-object \ -class $class \ -initblock $initblock \ - -defaultopts [list -accessor $accessor -objectparameter false] \ + -defaultopts [list -accessor $accessor -configparameter false] \ $spec \ {*}[expr {[info exists value] ? [list $value] : ""}]] @@ -1673,55 +1655,59 @@ } Object method attribute { + {-class ""} -incremental:switch -nocomplain:switch spec - {-class ""} {initblock ""} } { set r [[self] ::nsf::classes::nx::Object::variable \ + -accessor=true \ -class $class \ -incremental=$incremental \ - -nocomplain=$nocomplain \ -initblock $initblock \ - -accessor true \ + -nocomplain=$nocomplain \ {*}$spec] return $r } nx::Class method variable { + {-accessor:switch} {-class ""} + {-configparameter:switch} -incremental:switch {-initblock ""} - {-objectparameter false} - {-accessor false} spec default:optional } { if {$incremental} { - # incremental implies accessor + # the usage of "-incremental" implies "-accessor" set accessor true append initblock { set :incremental 1 } } - #puts stderr "Class variable $spec" set slot [::nx::MetaSlot createFromParameterSpec [::nsf::self] \ -class $class \ -initblock $initblock \ - -defaultopts [list -accessor $accessor -objectparameter $objectparameter] \ + -defaultopts [list -accessor $accessor -configparameter $configparameter] \ $spec \ {*}[expr {[info exists default] ? [list $default] : ""}]] return [::nsf::object::dispatch [self] ::nsf::methods::class::info::method handle [$slot name]] } - Class method attribute {-incremental:switch spec {-class ""} {initblock ""}} { + nx::Class method attribute { + {-class ""} + -incremental:switch + spec + {initblock ""} + } { set r [[self] ::nsf::classes::nx::Class::variable \ + -accessor=true \ -class $class \ + -configparameter=true \ -incremental=$incremental \ -initblock $initblock \ - -accessor true \ - -objectparameter true \ {*}$spec] return $r } Index: tests/disposition.test =================================================================== diff -u -rf3127511bec503add89e7a691f33213b1999274d -r46c536260f793729feb23fff02cc15e3867ae0ee --- tests/disposition.test (.../disposition.test) (revision f3127511bec503add89e7a691f33213b1999274d) +++ tests/disposition.test (.../disposition.test) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -1079,9 +1079,9 @@ :public method "FOO foo" args { append :msg "(1)--[current next]" next - puts stderr ++++++++++++++++++ + #puts stderr ++++++++++++++++++ append :msg "--(3)--[current class]--[current methodpath]--[current]" - puts stderr ++++++++++++++++++ + #puts stderr ++++++++++++++++++ } } @@ -1094,9 +1094,9 @@ # N+1 |:TclFrame| C setObjectParams [list] ? { - puts stderr "/ / / / / / / / / / / " + #puts stderr "/ / / / / / / / / / / " [C create c1] FOO foo; # N - puts stderr "/ / / / / / / / / / / " + #puts stderr "/ / / / / / / / / / / " c1 eval {set :msg} } "(1)--::c1--FOO--foo--(3)--::M2--FOO--::c1" Index: tests/parameters.test =================================================================== diff -u -r9c636251d106b1728258076165dd19e8af36b2c1 -r46c536260f793729feb23fff02cc15e3867ae0ee --- tests/parameters.test (.../parameters.test) (revision 9c636251d106b1728258076165dd19e8af36b2c1) +++ tests/parameters.test (.../parameters.test) (revision 46c536260f793729feb23fff02cc15e3867ae0ee) @@ -1772,9 +1772,7 @@ # # re-assignment must be requested by a reconfigure call # - puts stderr ====1 [o info slots a] reconfigure - puts stderr ====2 ? {o eval {info exists :a}} 1 ? {o a} anothervalue } @@ -1816,7 +1814,10 @@ # positional object level parameters do not make sense, since they # cannot be called. -nx::Test case variable { +# +# test object level attribute and variable +# +nx::Test case object-level-variable { nx::Object create ::enterprise { @@ -1891,15 +1892,21 @@ # testing incremental ? [list [self] variable -incremental -nocomplain i:int,0..* {}] "::enterprise::i" + ? [list [self] attribute -incremental -nocomplain j:int,0..* {}] "::enterprise::j" :i add 1 + :j add 1 ? [list [self] i] "1" + ? [list [self] j] "1" :i add 2 + :j add 2 ? [list [self] i] "2 1" + ? [list [self] j] "2 1" ? [list [self] i add a] {expected integer but got "a" for parameter "value"} + ? [list [self] j add a] {expected integer but got "a" for parameter "value"} } nx::Class create C { - # set 2 variables, one via variable, one via attribute + # set 2 class variables, one via variable, one via attribute ? [list [self] class variable -nocomplain v "v0"] "" ? [list [self] class attribute -nocomplain [list a "a0"]] "::C::a" @@ -1912,4 +1919,50 @@ ? [list [self] class variable -nocomplain y:int "a0"] {expected integer but got "a0"} } -} \ No newline at end of file +} + +# +# test class level attribute and variable +# +nx::Test case class-level-variable { + nx::Class create C { + + # define 2 class-level variables, one via variable, one via attribute + :variable v v0 + :attribute {a a0} + + # create an instance + :create c1 + } + + # in both cases, we expect instance variables for c1 + ? {lsort [c1 info vars]} {a v} + ? {c1 eval {set :v}} "v0" + ? {c1 eval {set :a}} "a0" + + # + # We expect a specifiable object parameter for "a" but not for "v". + # The parameter for v can be obtained via spec, but is not listed in + # "info parameter syntax" or "info parameter spec". + # + ? {C info parameter list a} "-a" + ? {C info parameter spec a} "{-a a0}" + ? {C info parameter syntax a} "?-a value?" + + ? {C info parameter spec v} "{-v:noconfig v0}" + ? {C info parameter list v} "" + ? {C info parameter syntax v} "" + + # TODO: the error message for the invalid object parameter should be + # improved. The problem is, that "-v" is passed to the initcmd, so + # just "10" is invalid. + ? {C create c2 -a 10} ::c2 + ? {C create c2 -v 10} \ + {Invalid argument '10', maybe too many arguments; should be "::c2 configure ?-a value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?"} + + # + # We expect a setter for "a" but not for "v". + # + ? {c1 info lookup method a} "::nsf::classes::C::a" + ? {c1 info lookup method v} "" +}