More tests, more fixes

1 files changed, 39 insertions, 23 deletions

diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 8d8dd2a..7a4a0bb 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -249,11 +249,13 @@ static const char *tclOOSetupScript =
 "\t\tunexport create createWithNamespace new\n"
 "\t}\n"
 "\t::namespace eval configuresupport {\n"
+"\t\tnamespace path ::tcl\n"
 "\t\tproc PropertyImpl {readslot writeslot args} {\n"
 "\t\t\tfor {set i 0} {$i < [llength $args]} {incr i} {\n"
 "\t\t\t\tset prop [lindex $args $i]\n"
 "\t\t\t\tif {[string match \"-*\" $prop]} {\n"
-"\t\t\t\t\treturn -code error -errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
 "\t\t\t\t\t\t\"bad property name \\\"$prop\\\"; must not begin with -\"\n"
 "\t\t\t\t}\n"
 "\t\t\t\tset realprop [string cat \"-\" $prop]\n"
@@ -263,27 +265,33 @@ static const char *tclOOSetupScript =
 "\t\t\t\twhile {[set next [lindex $args [expr {$i + 1}]]\n"
 "\t\t\t\t\t\tstring match \"-*\" $next]} {\n"
 "\t\t\t\t\tset arg [lindex $args [incr i 2]]\n"
-"\t\t\t\t\tswitch [::tcl::prefix match {-get -kind -set} $next] {\n"
+"\t\t\t\t\tswitch [prefix match -error [list -level 2 -errorcode \\\n"
+"\t\t\t\t\t\t\t[list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {\n"
 "\t\t\t\t\t\t-get {\n"
 "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
-"\t\t\t\t\t\t\t\treturn -code error -errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
 "\t\t\t\t\t\t\t\t\t\"missing body to go with -get option\"\n"
 "\t\t\t\t\t\t\t}\n"
 "\t\t\t\t\t\t\tset getter $arg\n"
 "\t\t\t\t\t\t}\n"
 "\t\t\t\t\t\t-set {\n"
 "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
-"\t\t\t\t\t\t\t\treturn -code error -errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
 "\t\t\t\t\t\t\t\t\t\"missing body to go with -set option\"\n"
 "\t\t\t\t\t\t\t}\n"
-"\t\t\t\t\t\t\tset getter $arg\n"
+"\t\t\t\t\t\t\tset setter $arg\n"
 "\t\t\t\t\t\t}\n"
 "\t\t\t\t\t\t-kind {\n"
 "\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
-"\t\t\t\t\t\t\t\treturn -code error -errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2\\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
 "\t\t\t\t\t\t\t\t\t\"missing kind value to go with -kind option\"\n"
 "\t\t\t\t\t\t\t}\n"
-"\t\t\t\t\t\t\tset kind [::tcl::prefix match -message \"kind\" {\n"
+"\t\t\t\t\t\t\tset kind [prefix match -message \"kind\" -error [list \\\n"
+"\t\t\t\t\t\t\t\t\t-level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode [list TCL LOOKUP INDEX kind $arg]] {\n"
 "\t\t\t\t\t\t\t\treadable readwrite writable\n"
 "\t\t\t\t\t\t\t} $arg]\n"
 "\t\t\t\t\t\t}\n"
@@ -291,25 +299,29 @@ static const char *tclOOSetupScript =
 "\t\t\t\t}\n"
 "\t\t\t\tswitch $kind {\n"
 "\t\t\t\t\treadable {\n"
-"\t\t\t\t\t\tuplevel 1 [list \\\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 1 [list \\\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 <ReadProp$realprop> {} $getter]\n"
 "\t\t\t\t\t}\n"
 "\t\t\t\t\twritable {\n"
-"\t\t\t\t\t\tuplevel 1 [list \\\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 1 [list \\\n"
+"\t\t\t\t\t\tuplevel 2 [list \\\n"
 "\t\t\t\t\t\t\t\tmethod <WriteProp$realprop> {value} $setter]\n"
 "\t\t\t\t\t}\n"
 "\t\t\t\t\treadwrite {\n"
-"\t\t\t\t\t\tuplevel 1 [list \\\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 1 [list \\\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 1 [list \\\n"
+"\t\t\t\t\t\tuplevel 2 [list \\\n"
 "\t\t\t\t\t\t\t\tmethod <ReadProp$realprop> {} $getter]\n"
-"\t\t\t\t\t\tuplevel 1 [list \\\n"
+"\t\t\t\t\t\tuplevel 2 [list \\\n"
 "\t\t\t\t\t\t\t\tmethod <WriteProp$realprop> {value} $setter]\n"
 "\t\t\t\t\t}\n"
 "\t\t\t\t}\n"
@@ -317,7 +329,7 @@ static const char *tclOOSetupScript =
 "\t\t}\n"
 "\t\tnamespace eval configurableclass {\n"
 "\t\t\t::proc property args {\n"
-"\t\t\t\t::tailcall ::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
 "\t\t\t\t\t::oo::configuresupport::readableproperties \\\n"
 "\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n"
 "\t\t\t}\n"
@@ -326,7 +338,7 @@ static const char *tclOOSetupScript =
 "\t\t}\n"
 "\t\tnamespace eval configurableobject {\n"
 "\t\t\t::proc property args {\n"
-"\t\t\t\t::tailcall ::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
 "\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n"
 "\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n"
 "\t\t\t}\n"
@@ -340,17 +352,21 @@ static const char *tclOOSetupScript =
 "\t\t\t}\n"
 "\t\t\treturn $result\n"
 "\t\t}\n"
-"\t\tproc Match {object propertyName kind} {\n"
-"\t\t\tset props [info object property $object -all $kind]\n"
-"\t\t\t::tcl::prefix match -message \"property\" $props $propertyName\n"
-"\t\t}\n"
 "\t\tproc ReadOne {object my propertyName} {\n"
-"\t\t\tset prop [Match $object $propertyName -readable]\n"
+"\t\t\tset props [info object property $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"
+"\t\t\t\t\t\t  $props $propertyName]\n"
 "\t\t\treturn [$my <ReadProp$prop>]\n"
 "\t\t}\n"
 "\t\tproc WriteMany {object my setterMap} {\n"
+"\t\t\tset props [info object property $object -all -writable]\n"
 "\t\t\tforeach {prop value} $setterMap {\n"
-"\t\t\t\tset prop [Match $object $prop -writable]\n"
+"\t\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 $prop]] \\\n"
+"\t\t\t\t\t\t\t  $props $prop]\n"
 "\t\t\t\t$my <WriteProp$prop> $value\n"
 "\t\t\t}\n"
 "\t\t\treturn\n"