Index: TODO =================================================================== diff -u -rdd2352511413900de40068dafb06731b23e14891 -r5ce68a42506fcc981cea2431afa1b09b476e667a --- TODO (.../TODO) (revision dd2352511413900de40068dafb06731b23e14891) +++ TODO (.../TODO) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -3992,9 +3992,20 @@ another two due to list-splitting to obtain default from arg). - extend regression test +nsf.c: +- allow parens in property names (array syntax) +- added "/obj/ info name" (as alternative to "namspace tail [self]") +nx.tcl: +- added "private property foo" +- extended regression test +- start error messages with a lower case word for consistency + and to follow closer to Tcl's conventions + ======================================================================== TODO: +- document "/obj/ info name" +- document "private property" - document new setable object properties perobjectdispatch and keepcallerself Index: library/nx/nx.tcl =================================================================== diff -u -r9d86a21ce592017198064ede7cd5144bd6cffe6f -r5ce68a42506fcc981cea2431afa1b09b476e667a --- library/nx/nx.tcl (.../nx.tcl) (revision 9d86a21ce592017198064ede7cd5144bd6cffe6f) +++ library/nx/nx.tcl (.../nx.tcl) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -261,8 +261,8 @@ # define unknown handler for class :method unknown {methodName args} { - error "Method '$methodName' unknown for [::nsf::self].\ - Consider '[::nsf::self] create $methodName $args' instead of '[::nsf::self] $methodName $args'" + error "method '$methodName' unknown for [::nsf::self];\ + consider '[::nsf::self] create $methodName $args' instead of '[::nsf::self] $methodName $args'" } # protected is not yet defined ::nsf::method::property [::nsf::self] unknown call-protected true @@ -498,18 +498,18 @@ puts stderr "+++ UNKNOWN raises error $errorMsg" } set ref "\"$m\" of $obj $path" - error "Unable to dispatch sub-method $ref; valid are: [join [lsort $valid] {, }]" + error "unable to dispatch sub-method $ref; valid are: [join [lsort $valid] {, }]" } :protected method defaultmethod {} { if {[catch {set obj [uplevel ::nsf::current]}]} { - error "Ensemble dispatch called outside of method context" + error "ensemble dispatch called outside of method context" } set path [::nsf::current methodpath] set l [string length $path] set submethods [$obj ::nsf::methods::object::info::lookupmethods -path "$path *"] foreach sm $submethods {set results([lindex [string range $sm $l+1 end] 0]) 1} - error "Valid submethods of $obj $path: [lsort [array names results]]" + error "valid submethods of $obj $path: [lsort [array names results]]" } # end of EnsembleObject @@ -809,7 +809,7 @@ # } # set body " # if {!\[::nsf::current isnextcall\]} { - # error \"Abstract method $methName $arglist called\" + # error \"abstract method $methName $arglist called\" # } else {::nsf::next} # " # if {${per-object}} { @@ -1132,7 +1132,7 @@ if {[string match __* $m]} continue lappend methods $m } - error "Method '$method' unknown for slot [::nsf::self]; valid are: {[lsort $methods]}" + error "method '$method' unknown for slot [::nsf::self]; valid are: {[lsort $methods]}" } ObjectParameterSlot protected method init {args} { @@ -1548,7 +1548,7 @@ ::nx::VariableSlot public method setCheckedInstVar {-nocomplain:switch value} { if {[::nsf::var::exists ${:domain} ${:name}] && !$nocomplain} { - error "Object ${:domain} has already an instance variable named '${:name}'" + error "object ${:domain} has already an instance variable named '${:name}'" } set options [:getParameterOptions -withMultiplicity true] if {[llength $options] > 0} { @@ -1766,7 +1766,7 @@ ::nx::VariableSlot public method add {obj prop value {pos 0}} { if {![:isMultivalued]} { #puts stderr "... vars [[self] info vars] // [[self] eval {set :multiplicity}]" - error "Property $prop of [set :domain] ist not multivalued" + error "property $prop of [set :domain] ist not multivalued" } if {[::nsf::var::exists $obj $prop]} { ::nsf::var::set $obj $prop [linsert [::nsf::var::set $obj $prop] $pos $value] @@ -1825,7 +1825,7 @@ set isSwitch [regsub {\mswitch\M} $parameterOptions boolean parameterOptions] if {[info exists defaultValue]} { if {[info exists :$name] && !$nocomplain} { - error "Object [self] has already an instance variable named '$name'" + error "object [self] has already an instance variable named '$name'" } if {$parameterOptions ne ""} { #puts stderr "*** ::nsf::is $parameterOptions $defaultValue // opts=$options" @@ -1843,7 +1843,7 @@ } elseif {$isSwitch} { set :$name 0 } else { - error "Variable definition for '$name' (without value and accessor) is useless" + error "variable definition for '$name' (without value and accessor) is useless" } return } Index: tests/methods.test =================================================================== diff -u -r59e100d383b22ea1407f5e5c40e303f2c6bb9027 -r5ce68a42506fcc981cea2431afa1b09b476e667a --- tests/methods.test (.../methods.test) (revision 59e100d383b22ea1407f5e5c40e303f2c6bb9027) +++ tests/methods.test (.../methods.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -280,7 +280,7 @@ ? {C A} 2 ? {C B} B2 ? {C C} C2 - ? {C D} "Method 'D' unknown for ::C. Consider '::C create D ' instead of '::C D '" + ? {C D} "method 'D' unknown for ::C; consider '::C create D ' instead of '::C D '" nx::Object create o { set x [:property a] @@ -397,10 +397,10 @@ ? {C protected object method bar {x} {return $x}} \ "'object' is not a method defining method" ? {C object method bar {x} {return $x}} \ - {Method 'object' unknown for ::C. Consider '::C create object method bar x {return $x}' instead of '::C object method bar x {return $x}'} + {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 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} + {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} } # Index: tests/parameters.test =================================================================== diff -u -rdd2352511413900de40068dafb06731b23e14891 -r5ce68a42506fcc981cea2431afa1b09b476e667a --- tests/parameters.test (.../parameters.test) (revision dd2352511413900de40068dafb06731b23e14891) +++ tests/parameters.test (.../parameters.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -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? 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 ?-class value? ?-private? spec ?initblock?"} "Test whether the colon prefix is suppressed" } ####################################################### @@ -1922,8 +1922,8 @@ ? [list [self] property [list y2:int b]] {expected integer but got "b"} # set variable again, without -nocomplain - ? [list [self] variable x1:int 1] {Object ::enterprise has already an instance variable named 'x1'} - ? [list [self] property [list x2:int 2]] {Object ::enterprise has already an instance variable named 'x2'} + ? [list [self] variable x1:int 1] {object ::enterprise has already an instance variable named 'x1'} + ? [list [self] property [list x2:int 2]] {object ::enterprise has already an instance variable named 'x2'} # set variable with a value checker, multiple ? [list [self] variable -nocomplain xm1:int,1..n {1 2 3}] "" @@ -1941,7 +1941,7 @@ # useless definition ? [list [self] variable dummy:int] \ - {Variable definition for 'dummy' (without value and accessor) is useless} + {variable definition for 'dummy' (without value and accessor) is useless} # # define an application specific converter Index: tests/protected.test =================================================================== diff -u -r41559ade739ad3f4f4282d7b2626f850cfdef9c6 -r5ce68a42506fcc981cea2431afa1b09b476e667a --- tests/protected.test (.../protected.test) (revision 41559ade739ad3f4f4282d7b2626f850cfdef9c6) +++ tests/protected.test (.../protected.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -683,3 +683,113 @@ ? {obj info methods} "child foo" } + +# +# Test protected and private class properties +# +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} + :public method foo {p} {return [: $p]} + :public method bar {p} {return [: -local $p]} + :public method baz {p v} {return [: -local $p $v]} + :create c1 + } + + ? {c1 a} a1 + ? {c1 b} {::c1: unable to dispatch method 'b'} + ? {c1 c} {::c1: unable to dispatch method 'c'} + + ? {c1 foo a} a1 + ? {c1 foo b} b1 + ? {c1 foo c} {::c1: unable to dispatch method 'c'} + + ? {c1 bar a} a1 + ? {c1 bar b} b1 + ? {c1 bar c} {c1} + + #? {lsort [c1 info vars]} "____C.c ____C.d a b" + ? {lsort [c1 info vars]} "__private a b" + ? {c1 eval {lsort [array names :__private]}} "::C,c ::C,d" + + ? {c1 bar d} {1} + ? {c1 baz d 2} {2} + ? {c1 bar d} {2} + ? {c1 baz d x} {expected integer but got "x" for parameter "value"} +} + + +# +# Test protected and private class properties +# +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} + :public method foo {p} {return [: $p]} + :public method bar {p} {return [: -local $p]} + :public method baz {p v} {return [: -local $p $v]} + } + + ? {o a} a1 + ? {o b} {::o: unable to dispatch method 'b'} + ? {o c} {::o: unable to dispatch method 'c'} + + ? {o foo a} a1 + ? {o foo b} b1 + ? {o foo c} {::o: unable to dispatch method 'c'} + + ? {o bar a} a1 + ? {o bar b} b1 + ? {o bar c} {c1} + + #? {lsort [o info vars]} "____C.c ____C.d a b" + ? {lsort [o info vars]} "__private a b" + ? {o eval {lsort [array names :__private]}} "::o,c ::o,d" + + ? {o bar d} {1} + ? {o baz d 2} {2} + ? {o bar d} {2} + ? {o baz d x} {expected integer but got "x" for parameter "value"} +} + +# +# Test protected and private class object properties +# +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} + :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]} + } + + ? {C a} a1 + ? {C b} {method 'b' unknown for ::C; consider '::C create b ' instead of '::C b '} + ? {C c} {method 'c' unknown for ::C; consider '::C create c ' instead of '::C c '} + + ? {C foo a} a1 + ? {C foo b} b1 + ? {C foo c} {method 'c' unknown for ::C; consider '::C create c ' instead of '::C c '} + + ? {C bar a} a1 + ? {C bar b} b1 + ? {C bar c} {c1} + + #? {lsort [o info vars]} "____C.c ____C.d a b" + ? {lsort [C info vars]} "__private a b" + ? {C eval {lsort [array names :__private]}} "::C,c ::C,d" + + ? {C bar d} {1} + ? {C baz d 2} {2} + ? {C bar d} {2} + ? {C baz d x} {expected integer but got "x" for parameter "value"} +} \ No newline at end of file Index: tests/submethods.test =================================================================== diff -u -rb2edd7ca322d0135e310c1ee1ce0cc1b39e7c86d -r5ce68a42506fcc981cea2431afa1b09b476e667a --- tests/submethods.test (.../submethods.test) (revision b2edd7ca322d0135e310c1ee1ce0cc1b39e7c86d) +++ tests/submethods.test (.../submethods.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -37,14 +37,14 @@ ? {o string length 1} length ? {o string tolower 2} tolower ? {o string toupper 2} \ - {Unable to dispatch sub-method "toupper" of ::o string; valid are: string info, string length, string tolower} + {unable to dispatch sub-method "toupper" of ::o string; valid are: string info, string length, string tolower} - ? {o string} "Valid submethods of ::o string: info length tolower" + ? {o string} "valid submethods of ::o string: info length tolower" ? {o foo a x} "x" ? {o foo a y} "y" ? {o foo a z} \ - {Unable to dispatch sub-method "z" of ::o foo a; valid are: foo a defaultmethod, foo a subcmdName, foo a unknown, foo a x, foo a y} + {unable to dispatch sub-method "z" of ::o foo a; valid are: foo a defaultmethod, foo a subcmdName, foo a unknown, foo a x, foo a y} ? {o info method type string} object # the following is a problem, when string has subcmd "info" @@ -53,12 +53,12 @@ ? {o string length aaa} "length" ? {o string info class} "info" ? {o string hugo} \ - {Unable to dispatch sub-method "hugo" of ::o string; valid are: string info, string length, string tolower} + {unable to dispatch sub-method "hugo" of ::o string; valid are: string info, string length, string tolower} Foo create f1 ? {f1 baz a m1 10} m1 ? {f1 baz a m3 10} \ - {Unable to dispatch sub-method "m3" of ::f1 baz a; valid are: baz a m1, baz a m2} + {unable to dispatch sub-method "m3" of ::f1 baz a; valid are: baz a m1, baz a m2} #unable to dispatch method baz a m3; valid subcommands of a: m1 m2} # @@ -85,12 +85,12 @@ :create f1 } - ? {o string} "Valid submethods of ::o string: info length tolower" - ? {o foo} "Valid submethods of ::o foo: a b" + ? {o string} "valid submethods of ::o string: info length tolower" + ? {o foo} "valid submethods of ::o foo: a b" - ? {f1 bar} "Valid submethods of ::f1 bar: m1 m2" - ? {f1 baz} "Valid submethods of ::f1 baz: a b" - ? {f1 baz a} "Valid submethods of ::f1 baz a: m1 m2" + ? {f1 bar} "valid submethods of ::f1 bar: m1 m2" + ? {f1 baz} "valid submethods of ::f1 baz: a b" + ? {f1 baz a} "valid submethods of ::f1 baz a: m1 m2" } # @@ -211,7 +211,7 @@ # call a submethod, which is nowhere defined ? {o1 info has typo M} \ - {Unable to dispatch sub-method "typo" of ::o1 info has; valid are: info has mixin, info has namespace, info has something better, info has something else, info has something path, info has type} + {unable to dispatch sub-method "typo" of ::o1 info has; valid are: info has mixin, info has namespace, info has something better, info has something else, info has something path, info has type} # call a submethod, which is only defined in the mixin ? {o1 info has something else} something @@ -222,14 +222,14 @@ # yet another missing case ? {o1 info has something wrong} \ - {Unable to dispatch sub-method "wrong" of ::o1 info has something; valid are: info has something better, info has something else, info has something path} + {unable to dispatch sub-method "wrong" of ::o1 info has something; valid are: info has something better, info has something else, info has something path} # call defaultcmds on ensembles - ? {lsort [o1 info has something]} "Valid submethods of ::o1 info has something: better else path" + ? {lsort [o1 info has something]} "valid submethods of ::o1 info has something: better else path" # defaultcmd has to return also subcmds of other shadowed ensembles - ? {lsort [o1 info has]} "Valid submethods of ::o1 info has: mixin namespace something type" - ? {lsort [o1 info]} "Valid submethods of ::o1 info: children class filter has info is lookup method methods mixin parent precedence properties slot vars" + ? {lsort [o1 info has]} "valid submethods of ::o1 info has: mixin namespace something type" + ? {lsort [o1 info]} "valid submethods of ::o1 info: children class filter has info is lookup method methods mixin name parent precedence properties slot vars" # returning methodpath in ensemble ? {o1 info has something path} "info has something path" Index: tests/tcloo.test =================================================================== diff -u -rc4997e0189bb712287aa53d12bb3e332acfb781d -r5ce68a42506fcc981cea2431afa1b09b476e667a --- tests/tcloo.test (.../tcloo.test) (revision c4997e0189bb712287aa53d12bb3e332acfb781d) +++ tests/tcloo.test (.../tcloo.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a) @@ -264,7 +264,7 @@ :class unexport create new } - ? {AbstractQueue new} {Method 'new' unknown for ::AbstractQueue. Consider '::AbstractQueue create new ' instead of '::AbstractQueue new '} - ? {AbstractQueue create aQueue} {Method 'create' unknown for ::AbstractQueue. Consider '::AbstractQueue create create aQueue' instead of '::AbstractQueue create aQueue'} + ? {AbstractQueue new} {method 'new' unknown for ::AbstractQueue; consider '::AbstractQueue create new ' instead of '::AbstractQueue new '} + ? {AbstractQueue create aQueue} {method 'create' unknown for ::AbstractQueue; consider '::AbstractQueue create create aQueue' instead of '::AbstractQueue create aQueue'} } \ No newline at end of file