diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2019-12-31 23:25:58 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2019-12-31 23:25:58 (GMT) |
| commit | 995eed36fdc1c5eba5c874e149f17e213a261e7c (patch) | |
| tree | 98b98331bfc844ba9be0ce594c6e14c59c24011c /tools | |
| parent | c4f94adb460fd2389bbf4b3db9befcbfb97dae0b (diff) | |
| download | tcl-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 'tools')
| -rw-r--r-- | tools/tclOOScript.tcl | 32 |
1 files changed, 23 insertions, 9 deletions
diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 095a3ad..12288e4 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -4,7 +4,7 @@ # that the code can be definitely run even in safe interpreters; TclOO's # core setup is safe. # -# Copyright (c) 2012-2018 Donal K. Fellows +# Copyright (c) 2012-2019 Donal K. Fellows # Copyright (c) 2013 Andreas Kupries # Copyright (c) 2017 Gerald Lester # @@ -626,10 +626,17 @@ proc ReadOne {object my propertyName} { 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]] \ - $props $propertyName] + try { + set prop [prefix match -message "property" $props $propertyName] + } on error {msg} { + catch { + set wps [info object properties $object -all -writable] + set wprop [prefix match $wps $propertyName] + set msg "property \"$wprop\" is write only" + } + return -code error -level 2 -errorcode [list \ + TCL LOOKUP INDEX property $propertyName] $msg + } try { set value [$my <ReadProp$prop>] } on error {msg opt} { @@ -659,10 +666,17 @@ proc WriteMany {object my setterMap} { set props [info object properties $object -all -writable] foreach {prop value} $setterMap { - set prop [prefix match -message "property" -error [list\ - -level 2 -errorcode [list \ - TCL LOOKUP INDEX property $prop]] \ - $props $prop] + try { + set prop [prefix match -message "property" $props $prop] + } on error {msg} { + catch { + set rps [info object properties $object -all -readable] + set rprop [prefix match $rps $prop] + set msg "property \"$rprop\" is read only" + } + return -code error -level 2 -errorcode [list \ + TCL LOOKUP INDEX property $prop] $msg + } try { $my <WriteProp$prop> $value } on error {msg opt} { |