summaryrefslogtreecommitdiffstats
path: root/generic/tclOOScript.h
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2019-12-31 23:25:58 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2019-12-31 23:25:58 (GMT)
commit995eed36fdc1c5eba5c874e149f17e213a261e7c (patch)
tree98b98331bfc844ba9be0ce594c6e14c59c24011c /generic/tclOOScript.h
parentc4f94adb460fd2389bbf4b3db9befcbfb97dae0b (diff)
downloadtcl-995eed36fdc1c5eba5c874e149f17e213a261e7c.zip
tcl-995eed36fdc1c5eba5c874e149f17e213a261e7c.tar.gz
tcl-995eed36fdc1c5eba5c874e149f17e213a261e7c.tar.bz2
Better error messages when a property has the wrong kind for the type of access desired
Diffstat (limited to 'generic/tclOOScript.h')
-rw-r--r--generic/tclOOScript.h30
1 files changed, 22 insertions, 8 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 9782875..ed8d2dd 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -362,10 +362,17 @@ static const char *tclOOSetupScript =
"\t\t}\n"
"\t\tproc ReadOne {object my propertyName} {\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"
-"\t\t\t\t\t\t $props $propertyName]\n"
+"\t\t\ttry {\n"
+"\t\t\t\tset prop [prefix match -message \"property\" $props $propertyName]\n"
+"\t\t\t} on error {msg} {\n"
+"\t\t\t\tcatch {\n"
+"\t\t\t\t\tset wps [info object properties $object -all -writable]\n"
+"\t\t\t\t\tset wprop [prefix match $wps $propertyName]\n"
+"\t\t\t\t\tset msg \"property \\\"$wprop\\\" is write only\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName] $msg\n"
+"\t\t\t}\n"
"\t\t\ttry {\n"
"\t\t\t\tset value [$my <ReadProp$prop>]\n"
"\t\t\t} on error {msg opt} {\n"
@@ -386,10 +393,17 @@ static const char *tclOOSetupScript =
"\t\tproc WriteMany {object my setterMap} {\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"
-"\t\t\t\t\t\tTCL LOOKUP INDEX property $prop]] \\\n"
-"\t\t\t\t\t\t\t $props $prop]\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\tset prop [prefix match -message \"property\" $props $prop]\n"
+"\t\t\t\t} on error {msg} {\n"
+"\t\t\t\t\tcatch {\n"
+"\t\t\t\t\t\tset rps [info object properties $object -all -readable]\n"
+"\t\t\t\t\t\tset rprop [prefix match $rps $prop]\n"
+"\t\t\t\t\t\tset msg \"property \\\"$rprop\\\" is read only\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\t\tTCL LOOKUP INDEX property $prop] $msg\n"
+"\t\t\t\t}\n"
"\t\t\t\ttry {\n"
"\t\t\t\t\t$my <WriteProp$prop> $value\n"
"\t\t\t\t} on error {msg opt} {\n"