Richard Suchenwirth 2001-08-01 - Here's an application of write traces 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:
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 info variable $var] end] end] return [join [lrange $trace 1 end] ..] } foreach i [uplevel 1 trace info variable $var] { if [regexp constrain $i] {uplevel 1 trace remove variable $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