[Richard Suchenwirth] 2001-08-01 - Here's an application of write
[trace]s to constrain a variable's value to either a range (numeric or string
prefix, joined with two dots) or a list of permitted values, that work on
scalars, arrays or array elements. Examples:
======
constrain x 0..1023
constrain y {yes no maybe}
constrain z(mode) A..Z
======
If a constraint is violated, an error is raised with a descriptive
message:
======none
can't set "y": value 'yesSir' outside constraint 'yes no maybe'
======
As usual with traces, constraints are deleted if the variable is unset.
If you still want to set an out-of-constraint value, just catch the
assignment:
======
catch {set y "definitely"}
======
This is because write traces fire after the assignment, so the "bad"
value is there anyway. Numeric constraints don't distinguish between int
and double values; string prefixes are just that, so "foo" is inside the
range "a..z" even if it's not a single character.
You can introspect the constraints you have set by calling
======
constrain name
======
which returns the active constraint in the same format, or an empty
string if the variable is not constrained. Also, you can remove a
constraint by overriding it with an empty string:
======
constrain name ""
======
[KPV] -- I like the idea, and like to offer a suggestion. How about an optional argument which the value the variable should take if it is out of range. Sometimes I think that throwing an error is too harsh, and catching that error still leaves that bad value in place.
======
proc constrain {var {cond -}} {
if {$cond=="-"} { set trace [lindex [lindex [uplevel 1 trace vinfo variable $var] end] end]
return [join [lrange $trace 1 end] ..]
} foreach i [uplevel 1 trace vinfo variable $var] {
if [regexp constrain $i] {uplevel 1 trace removde variablete $var $i}
}
if {$cond==""} return
if [regexp {(.+)[.][.](.+)} $cond -> from to] {
set trace [list constrainRange $from $to]
} else {
set trace [list constrainList $cond]
} uplevel 1 trace add variable $var write [list $trace]
}
proc constrainRange {from to _var el op} {
set name $_var[expr {$el!=""? "($el)": ""}]
upvar 1 $name var
if {$var<$from || $var>$to} {
return -code error "value $var outside constraint $from..$to"
}
}
proc constrainList {list _var el op} {
set name $_var[expr {$el!=""? "($el)": ""}]
upvar 1 $name var
if {[lsearch $list $var]<0} {
return -code error "value '$var' outside constraint '$list'"
}
}
======
See also [constants] for traces used to prevent a variable value from being changed, and [type checking].
----
'''[US]''' - Very nice, Richard. I propose a small enhancement:
The following modification of constrainList is able to handle multiple synonyms for each allowed value. The constrained variable is set to the first value of the matching list. Example:
======
% constrain x {{y yes ok true} {n no false}}
% set x ok
y
% set x false
n
% set x nay
can't set "x": value 'nay' outside constraint '{y yes ok true} {n no false}'
%
proc constrainList {list _var el op} {
set name $_var[expr {$el!=""? "($el)": ""}]
upvar 1 $name var
foreach val $list {
if {[lsearch $val $var]<0} {
continue
}
set var [lindex $val 0]
return
}
return -code error "value '$var' outside constraint '$list'"
}
======
----
See also [Assertions]
<<categories>> Concept | Arts and crafts of Tcl-Tk programming | Correctness