diff options
Diffstat (limited to 'tests/ttk/validate.test')
| -rw-r--r-- | tests/ttk/validate.test | 146 |
1 files changed, 67 insertions, 79 deletions
diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test index 89c3207..fc5545f 100644 --- a/tests/ttk/validate.test +++ b/tests/ttk/validate.test @@ -5,14 +5,19 @@ package require tk package require tcltest 2.2 +eval tcltest::configure $argv namespace import -force tcltest::* - loadTestedCommands +# Import utility procs for specific functional areas +testutils import entry +foreach i {1 2 3 4} { + set validateCmd$i [list validateCommand$i %W %d %i %P %s %S %v %V] +} + testConstraint ttkEntry 1 testConstraint coreEntry [expr {![testConstraint ttkEntry]}] -eval tcltest::configure $argv test validate-0.0 "Setup" -constraints ttkEntry -body { rename entry {} @@ -22,18 +27,14 @@ test validate-0.0 "Setup" -constraints ttkEntry -body { test validate-0.1 "More setup" -body { destroy .e - catch {unset ::e} - catch {unset ::vVals} + catch {unset textVar} + unset -nocomplain validationData; # not necessary entry .e -validate all \ - -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -validatecommand $validateCmd1 \ -invalidcommand bell \ - -textvariable ::e \ + -textvariable textVar \ ; pack .e - proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 1 - } } # The validation tests build each one upon the previous, so cascading @@ -41,149 +42,138 @@ test validate-0.1 "More setup" -body { # test validate-1.1 {entry widget validation - insert} -body { .e insert 0 a - set ::vVals + set validationData } -result {.e 1 0 a {} a all key} test validate-1.2 {entry widget validation - insert} -body { .e insert 1 b - set ::vVals + set validationData } -result {.e 1 1 ab a b all key} test validate-1.3 {entry widget validation - insert} -body { .e insert end c - set ::vVals + set validationData } -result {.e 1 2 abc ab c all key} test validate-1.4 {entry widget validation - insert} -body { .e insert 1 123 - list $::vVals $::e + list $validationData $textVar } -result {{.e 1 1 a123bc abc 123 all key} a123bc} test validate-1.5 {entry widget validation - delete} -body { .e delete 2 - set ::vVals + set validationData } -result {.e 0 2 a13bc a123bc 2 all key} test validate-1.6 {entry widget validation - delete} -body { .e configure -validate key .e delete 1 3 - set ::vVals + set validationData } -result {.e 0 1 abc a13bc 13 key key} test validate-1.7 {entry widget validation - vmode focus} -body { - set ::vVals {} + set validationData {} .e configure -validate focus .e insert end d - set ::vVals + set validationData } -result {} test validate-1.8 {entry widget validation - vmode focus} -body { - set ::vVals {} - set timer [after 300 lappend ::vVals timeout] + set validationData {} + set timer [after 300 validationData lappend timeout] focus -force .e - vwait ::vVals + vwait validationData after cancel $timer - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} focus focusin} test validate-1.9 {entry widget validation - vmode focus} -body { - set ::vVals {} - set timer [after 300 lappend ::vVals timeout] + set validationData {} + set timer [after 300 validationData lappend timeout] focus -force . - vwait ::vVals + vwait validationData after cancel $timer - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} focus focusout} .e configure -validate all test validate-1.10 {entry widget validation - vmode all} -body { - set ::vVals {} - set timer [after 300 lappend ::vVals timeout] + set validationData {} + set timer [after 300 validationData lappend timeout] focus -force .e - vwait ::vVals + vwait validationData after cancel $timer - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} all focusin} test validate-1.11 {entry widget validation} -body { - set ::vVals {} - set timer [after 300 lappend ::vVals timeout] + set validationData {} + set timer [after 300 validationData lappend timeout] focus -force . - vwait ::vVals + vwait validationData after cancel $timer - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} all focusout} .e configure -validate focusin test validate-1.12 {entry widget validation} -body { - set ::vVals {} - set timer [after 300 lappend ::vVals timeout] + set validationData {} + set timer [after 300 validationData lappend timeout] focus -force .e - vwait ::vVals + vwait validationData after cancel $timer - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} focusin focusin} test validate-1.13 {entry widget validation} -body { - set ::vVals {} + set validationData {} focus -force . update - set ::vVals + set validationData } -result {} .e configure -validate focuso test validate-1.14 {entry widget validation} -body { - set ::vVals {} + set validationData {} focus -force .e update - set ::vVals + set validationData } -result {} test validate-1.15 {entry widget validation} -body { focus -force . # update necessary to process FocusOut event update - set ::vVals + set validationData } -result {.e -1 -1 abcd abcd {} focusout focusout} # DIFFERENCE: core entry temporarily sets "-validate all", ttk::entry doesn't. test validate-1.16 {entry widget validation} -body { .e configure -validate all - list [.e validate] $::vVals + list [.e validate] $validationData } -result {1 {.e -1 -1 abcd abcd {} all forced}} # DIFFERENCE: ttk::entry does not perform validation when setting the -variable test validate-1.17 {entry widget validation} -constraints coreEntry -body { .e configure -validate all - set ::e newdata - list [.e cget -validate] $::vVals + set textVar newdata + list [.e cget -validate] $validationData } -result {all {.e -1 -1 newdata abcd {} all forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 0 -} - test validate-1.18 {entry widget validation} -constraints coreEntry -body { - .e configure -validate all - set ::e nextdata - list [.e cget -validate] $::vVals + .e configure -validate all -validatecommand $validateCmd3 + set textVar nextdata + list [.e cget -validate] $validationData } -result {none {.e -1 -1 nextdata newdata {} all forced}} # DIFFERENCE: ttk::entry doesn't validate when setting linked -variable # DIFFERENCE: ttk::entry doesn't disable validation -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - set ::e mydata - return 1 -} - ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set test validate-1.19 {entry widget validation} -constraints coreEntry -body { - .e configure -validate all + .e configure -validate all -validatecommand $validateCmd2 .e validate - list [.e cget -validate] [.e get] $::vVals + list [.e cget -validate] [.e get] $validationData } -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the @@ -194,31 +184,22 @@ test validate-1.19 {entry widget validation} -constraints coreEntry -body { # DIFFERENCE: ttk entry doesn't get out of sync w/textvar test validate-1.20 {entry widget validation} -constraints coreEntry -body { - .e configure -validate all - set ::e testdata - list [.e cget -validate] [.e get] $::e $::vVals + .e configure -validate all -validatecommand $validateCmd2 + set textVar testdata + list [.e cget -validate] [.e get] $textVar $validationData } -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} -# -# New tests, -JE: -# -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - .e delete 0 end; - .e insert end dovaldata - return 0 -} test validate-2.1 "Validation script changes value" -body { - .e configure -validate none - set ::e testdata + .e configure -validate none -validatecommand $validateCmd4 + set textVar testdata .e configure -validate all .e validate - list [.e get] $::e $::vVals + list [.e get] $textVar $validationData } -result {dovaldata dovaldata {.e -1 -1 testdata testdata {} all forced}} # DIFFERENCE: core entry disables validation, ttk entry does not. destroy .e -catch {unset ::e ::vVals} +catch {unset textVar} # See bug #1236979 @@ -281,6 +262,13 @@ test validate-3.6 "...until the value becomes valid" -constraints NA -body { test validate-3.last "Cleanup" -body { destroy .e } +# +# CLEANUP +# -### +foreach i {1 2 3 4} { + unset validateCmd$i +} +unset i +testutils forget entry tcltest::cleanupTests |