From c4f94adb460fd2389bbf4b3db9befcbfb97dae0b Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 31 Dec 2019 22:58:01 +0000 Subject: Other list-returning [info class] subcommands are plurals, so change property -> properties --- doc/configurable.n | 10 ++--- doc/info.n | 4 +- generic/tclOOInfo.c | 12 +++--- generic/tclOOScript.h | 40 ++++++++---------- tests/oo.test | 113 ++++++++++++++++++++++++++++---------------------- tools/tclOOScript.tcl | 42 +++++++++---------- 6 files changed, 113 insertions(+), 108 deletions(-) diff --git a/doc/configurable.n b/doc/configurable.n index f01f051..9a2a478 100644 --- a/doc/configurable.n +++ b/doc/configurable.n @@ -179,25 +179,25 @@ These slots, and their intended semantics, are: . The set of properties of a class (not including those from its superclasses) that may be read from when configuring an instance of the class. This slot can -also be read with the \fBinfo class property\fR command. +also be read with the \fBinfo class properties\fR command. .TP \fBoo::configuresupport::writableproperties\fR . The set of properties of a class (not including those from its superclasses) that may be written to when configuring an instance of the class. This slot -can also be read with the \fBinfo class property\fR command. +can also be read with the \fBinfo class properties\fR command. .TP \fBoo::configuresupport::objreadableproperties\fR . The set of properties of an object instance (not including those from its classes) that may be read from when configuring the object. This slot can -also be read with the \fBinfo object property\fR command. +also be read with the \fBinfo object properties\fR command. .TP \fBoo::configuresupport::objwritableproperties\fR . The set of properties of an object instance (not including those from its classes) that may be written to when configuring the object. This slot can -also be read with the \fBinfo object property\fR command. +also be read with the \fBinfo object properties\fR command. .PP Note that though these are slots, they are \fInot\fR in the standard \fBoo::define\fR or \fBoo::objdefine\fR namespaces; in order to use them @@ -207,7 +207,7 @@ system, and not directly used by normal user code. .SS "IMPLEMENTATION NOTE" .PP The implementation of the \fBconfigure\fR method uses -\fBinfo object property\fR with the \fB\-all\fR option to discover what +\fBinfo object properties\fR with the \fB\-all\fR option to discover what properties it may manipulate. .SH EXAMPLES .PP diff --git a/doc/info.n b/doc/info.n index ecf438b..cffaf49 100644 --- a/doc/info.n +++ b/doc/info.n @@ -492,7 +492,7 @@ be discovered with \fBinfo class forward\fR. This subcommand returns a list of all classes that have been mixed into the class named \fIclass\fR. .TP -\fBinfo class property\fI class\fR ?\fIoptions...\fR +\fBinfo class properties\fI class\fR ?\fIoptions...\fR .VS "TIP 558" This subcommand returns a sorted list of properties defined on the class named \fIclass\fR. The \fIoptions\fR define exactly which properties are returned: @@ -704,7 +704,7 @@ object named \fIobject\fR. This subcommand returns the name of the internal namespace of the object named \fIobject\fR. .TP -\fBinfo object property\fI object\fR ?\fIoptions...\fR +\fBinfo object properties\fI object\fR ?\fIoptions...\fR .VS "TIP 558" This subcommand returns a sorted list of properties defined on the object named \fIobject\fR. The \fIoptions\fR define exactly which properties are diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index ed44cc8..ffdcc10 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -64,7 +64,7 @@ static const EnsembleImplMap infoObjectCmds[] = { {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0}, - {"property", InfoObjectPropCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"properties", InfoObjectPropCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"variables", InfoObjectVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} @@ -86,7 +86,7 @@ static const EnsembleImplMap infoClassCmds[] = { {"methods", InfoClassMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"methodtype", InfoClassMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"property", InfoClassPropCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"properties", InfoClassPropCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, {"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"variables", InfoClassVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, @@ -1723,8 +1723,8 @@ InfoClassCallCmd( * * InfoClassPropCmd, InfoObjectPropCmd -- * - * Implements [info class property $clsName ?$option...?] and - * [info object property $objName ?$option...?] + * Implements [info class properties $clsName ?$option...?] and + * [info object properties $objName ?$option...?] * * ---------------------------------------------------------------------- */ @@ -1867,7 +1867,9 @@ InfoObjectPropCmd( * ---------------------------------------------------------------------- * * SortPropList -- - * Sort a list of names of properties. Simple support function. + * Sort a list of names of properties. Simple support function. Assumes + * that the list Tcl_Obj is unshared and doesn't have a string + * representation. * * ---------------------------------------------------------------------- */ diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index e8fd814..9782875 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -297,32 +297,24 @@ static const char *tclOOSetupScript = "\t\t\t\t\t\t}\n" "\t\t\t\t\t}\n" "\t\t\t\t}\n" +"\t\t\t\tset reader \n" +"\t\t\t\tset writer \n" "\t\t\t\tswitch $kind {\n" "\t\t\t\t\treadable {\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$readslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$writeslot -remove $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\tmethod {} $getter]\n" +"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list $writeslot -remove $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n" "\t\t\t\t\t}\n" "\t\t\t\t\twritable {\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$readslot -remove $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$writeslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\tmethod {value} $setter]\n" +"\t\t\t\t\t\tuplevel 2 [list $readslot -remove $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n" "\t\t\t\t\t}\n" "\t\t\t\t\treadwrite {\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$readslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\t$writeslot -append $realprop]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\tmethod {} $getter]\n" -"\t\t\t\t\t\tuplevel 2 [list \\\n" -"\t\t\t\t\t\t\t\tmethod {value} $setter]\n" +"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n" +"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n" +"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n" "\t\t\t\t\t}\n" "\t\t\t\t}\n" "\t\t\t}\n" @@ -333,6 +325,7 @@ static const char *tclOOSetupScript = "\t\t\t\t\t::oo::configuresupport::readableproperties \\\n" "\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n" "\t\t\t}\n" +"\t\t\t::proc properties args {::tailcall property {*}$args}\n" "\t\t\t::namespace path ::oo::define\n" "\t\t\t::namespace export property\n" "\t\t}\n" @@ -342,12 +335,13 @@ static const char *tclOOSetupScript = "\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n" "\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n" "\t\t\t}\n" +"\t\t\t::proc properties args {::tailcall property {*}$args}\n" "\t\t\t::namespace path ::oo::objdefine\n" "\t\t\t::namespace export property\n" "\t\t}\n" "\t\tproc ReadAll {object my} {\n" "\t\t\tset result {}\n" -"\t\t\tforeach prop [info object property $object -all -readable] {\n" +"\t\t\tforeach prop [info object properties $object -all -readable] {\n" "\t\t\t\ttry {\n" "\t\t\t\t\tdict set result $prop [$my ]\n" "\t\t\t\t} on error {msg opt} {\n" @@ -367,7 +361,7 @@ static const char *tclOOSetupScript = "\t\t\treturn $result\n" "\t\t}\n" "\t\tproc ReadOne {object my propertyName} {\n" -"\t\t\tset props [info object property $object -all -readable]\n" +"\t\t\tset props [info object properties $object -all -readable]\n" "\t\t\tset prop [prefix match -message \"property\" -error [list\\\n" "\t\t\t\t\t-level 2 -errorcode [list \\\n" "\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName]] \\\n" @@ -390,7 +384,7 @@ static const char *tclOOSetupScript = "\t\t\treturn $value\n" "\t\t}\n" "\t\tproc WriteMany {object my setterMap} {\n" -"\t\t\tset props [info object property $object -all -writable]\n" +"\t\t\tset props [info object properties $object -all -writable]\n" "\t\t\tforeach {prop value} $setterMap {\n" "\t\t\t\tset prop [prefix match -message \"property\" -error [list\\\n" "\t\t\t\t\t-level 2 -errorcode [list \\\n" diff --git a/tests/oo.test b/tests/oo.test index 631c84d..3fce886 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2424,7 +2424,7 @@ test oo-16.2 {OO: object introspection} -body { } -returnCodes 1 -result {NOTANOBJECT does not refer to an object} test oo-16.3 {OO: object introspection} -body { info object gorp oo::object -} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, property, variables, or vars} +} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, properties, variables, or vars} test oo-16.4 {OO: object introspection} -setup { oo::class create meta { superclass oo::class } [meta create instance1] create instance2 @@ -2643,7 +2643,7 @@ test oo-17.3 {OO: class introspection} -setup { } -result {"foo" is not a class} test oo-17.4 {OO: class introspection} -body { info class gorp oo::object -} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, property, subclasses, superclasses, or variables} +} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, properties, subclasses, superclasses, or variables} test oo-17.5 {OO: class introspection} -setup { oo::class create testClass } -body { @@ -5455,15 +5455,15 @@ test oo-44.1 {TIP 558: properties: core support} -setup { set result {} } -body { oo::class create c {superclass parent} - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::readableproperties -set a b c - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::readableproperties -set f e d - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::readableproperties -set a a a - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::readableproperties -set - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] } -cleanup { parent destroy } -result {{} {} {a b c} {} {d e f} {} a {} {} {}} @@ -5473,15 +5473,15 @@ test oo-44.2 {TIP 558: properties: core support} -setup { set result {} } -body { oo::class create c {superclass parent} - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::readableproperties -set a b c - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::readableproperties -set f e d - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::readableproperties -set a a a - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::readableproperties -set - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] } -cleanup { parent destroy } -result {{} {} {a b c} {} {d e f} {} a {} {} {}} @@ -5491,15 +5491,15 @@ test oo-44.3 {TIP 558: properties: core support} -setup { set result {} } -body { oo::class create c {superclass parent} - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::writableproperties -set a b c - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::writableproperties -set f e d - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::writableproperties -set a a a - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] oo::define c ::oo::configuresupport::writableproperties -set - lappend result [info class property c] [info class property c -writable] + lappend result [info class properties c] [info class properties c -writable] } -cleanup { parent destroy } -result {{} {} {} {a b c} {} {d e f} {} a {} {}} @@ -5509,15 +5509,15 @@ test oo-44.4 {TIP 558: properties: core support} -setup { set result {} } -body { oo::class create c {superclass parent} - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::writableproperties -set a b c - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::writableproperties -set f e d - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::writableproperties -set a a a - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] oo::define c ::oo::configuresupport::writableproperties -set - lappend result [info class property c -all] [info class property c -writable -all] + lappend result [info class properties c -all] [info class properties c -writable -all] } -cleanup { parent destroy } -result {{} {} {} {a b c} {} {d e f} {} a {} {}} @@ -5528,20 +5528,20 @@ test oo-44.5 {TIP 558: properties: core support} -setup { } -body { oo::class create c {superclass parent} oo::class create d {superclass c} - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::readableproperties -set a b c oo::define d ::oo::configuresupport::readableproperties -set x y z - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::readableproperties -set f e d oo::define d ::oo::configuresupport::readableproperties -set r p q - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::readableproperties -set a a h oo::define d ::oo::configuresupport::readableproperties -set g h g - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::readableproperties -set - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define d ::oo::configuresupport::readableproperties -set - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] } -cleanup { parent destroy } -result {{} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {} {}} @@ -5552,20 +5552,20 @@ test oo-44.6 {TIP 558: properties: core support} -setup { } -body { oo::class create c {superclass parent} oo::class create d {superclass c} - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::writableproperties -set a b c oo::define d ::oo::configuresupport::writableproperties -set x y z - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::writableproperties -set f e d oo::define d ::oo::configuresupport::writableproperties -set r p q - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::writableproperties -set a a h oo::define d ::oo::configuresupport::writableproperties -set g h g - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define c ::oo::configuresupport::writableproperties -set - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] oo::define d ::oo::configuresupport::writableproperties -set - lappend result [info class property d -all] [info class property d -writable -all] + lappend result [info class properties d -all] [info class properties d -writable -all] } -cleanup { parent destroy } -result {{} {} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {}} @@ -5576,15 +5576,15 @@ test oo-44.7 {TIP 558: properties: core support} -setup { } -body { oo::class create c {superclass parent} c create o - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objreadableproperties -set a b c - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objreadableproperties -set a a h - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objreadableproperties -set - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] } -cleanup { parent destroy } -result {{} {} {a b c} {} {d e f} {} {a h} {} {} {}} @@ -5595,15 +5595,15 @@ test oo-44.8 {TIP 558: properties: core support} -setup { } -body { oo::class create c {superclass parent} c create o - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objwritableproperties -set a b c - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objwritableproperties -set a a h - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] oo::objdefine o ::oo::configuresupport::objwritableproperties -set - lappend result [info object property o] [info object property o -writable] + lappend result [info object properties o] [info object properties o -writable] } -cleanup { parent destroy } -result {{} {} {} {a b c} {} {d e f} {} {a h} {} {}} @@ -5615,13 +5615,13 @@ test oo-44.9 {TIP 558: properties: core support} -setup { oo::class create c {superclass parent} oo::class create d {superclass c} d create o - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] oo::define c ::oo::configuresupport::readableproperties -set a b oo::define d ::oo::configuresupport::readableproperties -set c d oo::objdefine o ::oo::configuresupport::objreadableproperties -set e f - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d b e - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] } -cleanup { parent destroy } -result {{} {} {a b c d e f} {} {a b c d e f} {}} @@ -5633,13 +5633,13 @@ test oo-44.10 {TIP 558: properties: core support} -setup { oo::class create c {superclass parent} oo::class create d {superclass c} d create o - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] oo::define c ::oo::configuresupport::writableproperties -set a b oo::define d ::oo::configuresupport::writableproperties -set c d oo::objdefine o ::oo::configuresupport::objwritableproperties -set e f - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d b e - lappend result [info object property o -all] [info object property o -writable -all] + lappend result [info object properties o -all] [info object properties o -writable -all] } -cleanup { parent destroy } -result {{} {} {} {a b c d e f} {} {a b c d e f}} @@ -6111,6 +6111,19 @@ test oo-46.22 {TIP 558: properties: declaration semantics} -setup { } -cleanup { parent destroy } -result ok +test oo-46.23 {TIP 558: properties: declaration semantics} -setup { + oo::class create parent +} -body { + oo::configurable create Point { + superclass parent + private property var + } + Point create pt + pt configure -var ok + pt configure -var +} -cleanup { + parent destroy +} -result ok test oo-47.1 {TIP 558: properties: error details} -setup { oo::class create parent diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 56a7bf8..095a3ad 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -528,32 +528,24 @@ } # Install the option + set reader + set writer switch $kind { readable { - uplevel 2 [list \ - $readslot -append $realprop] - uplevel 2 [list \ - $writeslot -remove $realprop] - uplevel 2 [list \ - method {} $getter] + uplevel 2 [list $readslot -append $realprop] + uplevel 2 [list $writeslot -remove $realprop] + uplevel 2 [list method $reader -unexport {} $getter] } writable { - uplevel 2 [list \ - $readslot -remove $realprop] - uplevel 2 [list \ - $writeslot -append $realprop] - uplevel 2 [list \ - method {value} $setter] + uplevel 2 [list $readslot -remove $realprop] + uplevel 2 [list $writeslot -append $realprop] + uplevel 2 [list method $writer -unexport {value} $setter] } readwrite { - uplevel 2 [list \ - $readslot -append $realprop] - uplevel 2 [list \ - $writeslot -append $realprop] - uplevel 2 [list \ - method {} $getter] - uplevel 2 [list \ - method {value} $setter] + uplevel 2 [list $readslot -append $realprop] + uplevel 2 [list $writeslot -append $realprop] + uplevel 2 [list method $reader -unexport {} $getter] + uplevel 2 [list method $writer -unexport {value} $setter] } } } @@ -575,6 +567,8 @@ ::oo::configuresupport::readableproperties \ ::oo::configuresupport::writableproperties {*}$args } + # Plural alias just in case; deliberately NOT documented! + ::proc properties args {::tailcall property {*}$args} ::namespace path ::oo::define ::namespace export property } @@ -585,6 +579,8 @@ ::oo::configuresupport::objreadableproperties \ ::oo::configuresupport::objwritableproperties {*}$args } + # Plural alias just in case; deliberately NOT documented! + ::proc properties args {::tailcall property {*}$args} ::namespace path ::oo::objdefine ::namespace export property } @@ -599,7 +595,7 @@ proc ReadAll {object my} { set result {} - foreach prop [info object property $object -all -readable] { + foreach prop [info object properties $object -all -readable] { try { dict set result $prop [$my ] } on error {msg opt} { @@ -629,7 +625,7 @@ # ------------------------------------------------------------------ proc ReadOne {object my propertyName} { - set props [info object property $object -all -readable] + set props [info object properties $object -all -readable] set prop [prefix match -message "property" -error [list\ -level 2 -errorcode [list \ TCL LOOKUP INDEX property $propertyName]] \ @@ -661,7 +657,7 @@ # ------------------------------------------------------------------ proc WriteMany {object my setterMap} { - set props [info object property $object -all -writable] + set props [info object properties $object -all -writable] foreach {prop value} $setterMap { set prop [prefix match -message "property" -error [list\ -level 2 -errorcode [list \ -- cgit v0.12