1 #-----------------------------------------------------------------------
9 # Snit validation types.
11 #-----------------------------------------------------------------------
13 namespace eval ::snit:: {
26 #-----------------------------------------------------------------------
29 snit::type ::snit::boolean {
30 #-------------------------------------------------------------------
33 typemethod validate {value} {
34 if {![string is boolean -strict $value]} {
35 return -code error -errorcode INVALID \
36 "invalid boolean \"$value\", should be one of: 1, 0, true, false, yes, no, on, off"
43 #-------------------------------------------------------------------
46 # None needed; no options
48 #-------------------------------------------------------------------
51 method validate {value} {
56 #-----------------------------------------------------------------------
59 snit::type ::snit::double {
60 #-------------------------------------------------------------------
67 option -min -default "" -readonly 1
73 option -max -default "" -readonly 1
75 #-------------------------------------------------------------------
78 typemethod validate {value} {
79 if {![string is double -strict $value]} {
80 return -code error -errorcode INVALID \
81 "invalid value \"$value\", expected double"
87 #-------------------------------------------------------------------
91 # FIRST, get the options
92 $self configurelist $args
94 if {"" != $options(-min) &&
95 ![string is double -strict $options(-min)]} {
97 "invalid -min: \"$options(-min)\""
100 if {"" != $options(-max) &&
101 ![string is double -strict $options(-max)]} {
103 "invalid -max: \"$options(-max)\""
106 if {"" != $options(-min) &&
107 "" != $options(-max) &&
108 $options(-max) < $options(-min)} {
109 return -code error "-max < -min"
113 #-------------------------------------------------------------------
116 # Fixed method for the snit::double type.
118 method validate {value} {
119 $type validate $value
121 if {("" != $options(-min) && $value < $options(-min)) ||
122 ("" != $options(-max) && $value > $options(-max))} {
124 set msg "invalid value \"$value\", expected double"
126 if {"" != $options(-min) && "" != $options(-max)} {
127 append msg " in range $options(-min), $options(-max)"
128 } elseif {"" != $options(-min)} {
129 append msg " no less than $options(-min)"
130 } elseif {"" != $options(-max)} {
131 append msg " no greater than $options(-max)"
134 return -code error -errorcode INVALID $msg
141 #-----------------------------------------------------------------------
144 snit::type ::snit::enum {
145 #-------------------------------------------------------------------
150 # Valid values for this type
152 option -values -default {} -readonly 1
154 #-------------------------------------------------------------------
157 typemethod validate {value} {
158 # No -values specified; it's always valid
162 #-------------------------------------------------------------------
166 $self configurelist $args
168 if {[llength $options(-values)] == 0} {
170 "invalid -values: \"\""
174 #-------------------------------------------------------------------
177 method validate {value} {
178 if {[lsearch -exact $options(-values) $value] == -1} {
179 return -code error -errorcode INVALID \
180 "invalid value \"$value\", should be one of: [join $options(-values) {, }]"
187 #-----------------------------------------------------------------------
190 snit::type ::snit::fpixels {
191 #-------------------------------------------------------------------
198 option -min -default "" -readonly 1
204 option -max -default "" -readonly 1
206 #-------------------------------------------------------------------
209 variable min "" ;# -min, no suffix
210 variable max "" ;# -max, no suffix
212 #-------------------------------------------------------------------
215 typemethod validate {value} {
216 if {[catch {winfo fpixels . $value} dummy]} {
217 return -code error -errorcode INVALID \
218 "invalid value \"$value\", expected fpixels"
224 #-------------------------------------------------------------------
228 # FIRST, get the options
229 $self configurelist $args
231 if {"" != $options(-min) &&
232 [catch {winfo fpixels . $options(-min)} min]} {
234 "invalid -min: \"$options(-min)\""
237 if {"" != $options(-max) &&
238 [catch {winfo fpixels . $options(-max)} max]} {
240 "invalid -max: \"$options(-max)\""
246 return -code error "-max < -min"
250 #-------------------------------------------------------------------
253 method validate {value} {
254 $type validate $value
256 set val [winfo fpixels . $value]
258 if {("" != $min && $val < $min) ||
259 ("" != $max && $val > $max)} {
261 set msg "invalid value \"$value\", expected fpixels"
263 if {"" != $min && "" != $max} {
264 append msg " in range $options(-min), $options(-max)"
265 } elseif {"" != $min} {
266 append msg " no less than $options(-min)"
269 return -code error -errorcode INVALID $msg
276 #-----------------------------------------------------------------------
279 snit::type ::snit::integer {
280 #-------------------------------------------------------------------
287 option -min -default "" -readonly 1
293 option -max -default "" -readonly 1
295 #-------------------------------------------------------------------
298 typemethod validate {value} {
299 if {![string is integer -strict $value]} {
300 return -code error -errorcode INVALID \
301 "invalid value \"$value\", expected integer"
307 #-------------------------------------------------------------------
311 # FIRST, get the options
312 $self configurelist $args
314 if {"" != $options(-min) &&
315 ![string is integer -strict $options(-min)]} {
317 "invalid -min: \"$options(-min)\""
320 if {"" != $options(-max) &&
321 ![string is integer -strict $options(-max)]} {
323 "invalid -max: \"$options(-max)\""
326 if {"" != $options(-min) &&
327 "" != $options(-max) &&
328 $options(-max) < $options(-min)} {
329 return -code error "-max < -min"
333 #-------------------------------------------------------------------
336 method validate {value} {
337 $type validate $value
339 if {("" != $options(-min) && $value < $options(-min)) ||
340 ("" != $options(-max) && $value > $options(-max))} {
342 set msg "invalid value \"$value\", expected integer"
344 if {"" != $options(-min) && "" != $options(-max)} {
345 append msg " in range $options(-min), $options(-max)"
346 } elseif {"" != $options(-min)} {
347 append msg " no less than $options(-min)"
350 return -code error -errorcode INVALID $msg
357 #-----------------------------------------------------------------------
360 snit::type ::snit::listtype {
361 #-------------------------------------------------------------------
366 # Specifies a value type
368 option -type -readonly 1
372 # Minimum list length
374 option -minlen -readonly 1 -default 0
378 # Maximum list length
380 option -maxlen -readonly 1
382 #-------------------------------------------------------------------
385 typemethod validate {value} {
386 if {[catch {llength $value} result]} {
387 return -code error -errorcode INVALID \
388 "invalid value \"$value\", expected list"
394 #-------------------------------------------------------------------
398 # FIRST, get the options
399 $self configurelist $args
401 if {"" != $options(-minlen) &&
402 (![string is integer -strict $options(-minlen)] ||
403 $options(-minlen) < 0)} {
405 "invalid -minlen: \"$options(-minlen)\""
408 if {"" == $options(-minlen)} {
409 set options(-minlen) 0
412 if {"" != $options(-maxlen) &&
413 ![string is integer -strict $options(-maxlen)]} {
415 "invalid -maxlen: \"$options(-maxlen)\""
418 if {"" != $options(-maxlen) &&
419 $options(-maxlen) < $options(-minlen)} {
420 return -code error "-maxlen < -minlen"
425 #-------------------------------------------------------------------
428 method validate {value} {
429 $type validate $value
431 set len [llength $value]
433 if {$len < $options(-minlen)} {
434 return -code error -errorcode INVALID \
435 "value has too few elements; at least $options(-minlen) expected"
436 } elseif {"" != $options(-maxlen)} {
437 if {$len > $options(-maxlen)} {
438 return -code error -errorcode INVALID \
439 "value has too many elements; no more than $options(-maxlen) expected"
443 # NEXT, check each value
444 if {"" != $options(-type)} {
445 foreach item $value {
446 set cmd $options(-type)
447 lappend cmd validate $item
456 #-----------------------------------------------------------------------
459 snit::type ::snit::pixels {
460 #-------------------------------------------------------------------
467 option -min -default "" -readonly 1
473 option -max -default "" -readonly 1
475 #-------------------------------------------------------------------
478 variable min "" ;# -min, no suffix
479 variable max "" ;# -max, no suffix
481 #-------------------------------------------------------------------
484 typemethod validate {value} {
485 if {[catch {winfo pixels . $value} dummy]} {
486 return -code error -errorcode INVALID \
487 "invalid value \"$value\", expected pixels"
493 #-------------------------------------------------------------------
497 # FIRST, get the options
498 $self configurelist $args
500 if {"" != $options(-min) &&
501 [catch {winfo pixels . $options(-min)} min]} {
503 "invalid -min: \"$options(-min)\""
506 if {"" != $options(-max) &&
507 [catch {winfo pixels . $options(-max)} max]} {
509 "invalid -max: \"$options(-max)\""
515 return -code error "-max < -min"
519 #-------------------------------------------------------------------
522 method validate {value} {
523 $type validate $value
525 set val [winfo pixels . $value]
527 if {("" != $min && $val < $min) ||
528 ("" != $max && $val > $max)} {
530 set msg "invalid value \"$value\", expected pixels"
532 if {"" != $min && "" != $max} {
533 append msg " in range $options(-min), $options(-max)"
534 } elseif {"" != $min} {
535 append msg " no less than $options(-min)"
538 return -code error -errorcode INVALID $msg
545 #-----------------------------------------------------------------------
548 snit::type ::snit::stringtype {
549 #-------------------------------------------------------------------
554 # Minimum list length
556 option -minlen -readonly 1 -default 0
560 # Maximum list length
562 option -maxlen -readonly 1
566 # globs and regexps are case-insensitive if -nocase 1.
568 option -nocase -readonly 1 -default 0
572 # Glob-match pattern, or ""
574 option -glob -readonly 1
578 # Regular expression to match
580 option -regexp -readonly 1
582 #-------------------------------------------------------------------
585 typemethod validate {value} {
586 # By default, any string (hence, any Tcl value) is valid.
590 #-------------------------------------------------------------------
594 # FIRST, get the options
595 $self configurelist $args
597 # NEXT, validate -minlen and -maxlen
598 if {"" != $options(-minlen) &&
599 (![string is integer -strict $options(-minlen)] ||
600 $options(-minlen) < 0)} {
602 "invalid -minlen: \"$options(-minlen)\""
605 if {"" == $options(-minlen)} {
606 set options(-minlen) 0
609 if {"" != $options(-maxlen) &&
610 ![string is integer -strict $options(-maxlen)]} {
612 "invalid -maxlen: \"$options(-maxlen)\""
615 if {"" != $options(-maxlen) &&
616 $options(-maxlen) < $options(-minlen)} {
617 return -code error "-maxlen < -minlen"
620 # NEXT, validate -nocase
621 if {[catch {snit::boolean validate $options(-nocase)} result]} {
622 return -code error "invalid -nocase: $result"
626 if {"" != $options(-glob) &&
627 [catch {string match $options(-glob) ""} dummy]} {
629 "invalid -glob: \"$options(-glob)\""
632 # Validate the regexp
633 if {"" != $options(-regexp) &&
634 [catch {regexp $options(-regexp) ""} dummy]} {
636 "invalid -regexp: \"$options(-regexp)\""
641 #-------------------------------------------------------------------
644 method validate {value} {
645 # Usually we'd call [$type validate $value] here, but
646 # as it's a no-op, don't bother.
648 # FIRST, validate the length.
649 set len [string length $value]
651 if {$len < $options(-minlen)} {
652 return -code error -errorcode INVALID \
653 "too short: at least $options(-minlen) characters expected"
654 } elseif {"" != $options(-maxlen)} {
655 if {$len > $options(-maxlen)} {
656 return -code error -errorcode INVALID \
657 "too long: no more than $options(-maxlen) characters expected"
661 # NEXT, check the glob match, with or without case.
662 if {"" != $options(-glob)} {
663 if {$options(-nocase)} {
664 set result [string match -nocase $options(-glob) $value]
666 set result [string match $options(-glob) $value]
670 return -code error -errorcode INVALID \
671 "invalid value \"$value\""
675 # NEXT, check regexp match with or without case
676 if {"" != $options(-regexp)} {
677 if {$options(-nocase)} {
678 set result [regexp -nocase -- $options(-regexp) $value]
680 set result [regexp -- $options(-regexp) $value]
684 return -code error -errorcode INVALID \
685 "invalid value \"$value\""
693 #-----------------------------------------------------------------------
696 snit::type ::snit::window {
697 #-------------------------------------------------------------------
700 typemethod validate {value} {
701 if {![winfo exists $value]} {
702 return -code error -errorcode INVALID \
703 "invalid value \"$value\", value is not a window"
709 #-------------------------------------------------------------------
712 # None needed; no options
714 #-------------------------------------------------------------------
717 method validate {value} {
718 $type validate $value