##
## Entry widget validation tests
## Derived from core test suite entry-19.1 through entry-19.20
##
package require Tk
package require tcltest 2.1
namespace import -force tcltest::*
testConstraint useTile 1
testConstraint NYI [expr ![testConstraint useTile]]
eval tcltest::configure $argv
test validate-0.0 "Setup" -constraints useTile -body {
lappend auto_path . ; package require tile
rename entry {}
interp alias {} entry {} tentry
return;
}
test validate-0.1 "More setup" -body {
destroy .e
catch {unset ::e}
catch {unset ::vVals}
entry .e -validate all \
-validatecommand [list doval %W %d %i %P %s %S %v %V] \
-invalidcommand bell \
-textvariable ::e \
;
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
# failures aren't good
#
test validate-1.1 {entry widget validation - insert} -body {
.e insert 0 a
set ::vVals
} -result {.e 1 0 a {} a all key}
test validate-1.2 {entry widget validation - insert} -body {
.e insert 1 b
set ::vVals
} -result {.e 1 1 ab a b all key}
test validate-1.3 {entry widget validation - insert} -body {
.e insert end c
set ::vVals
} -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
} -result {{.e 1 1 a123bc abc 123 all key} a123bc}
test validate-1.5 {entry widget validation - delete} -body {
.e delete 2
set ::vVals
} -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
} -result {.e 0 1 abc a13bc 13 key key}
test validate-1.7 {entry widget validation - vmode focus} -body {
set ::vVals {}
.e configure -validate focus
.e insert end d
set ::vVals
} -result {}
test validate-1.8 {entry widget validation - vmode focus} -body {
focus -force .e
# update necessary to process FocusIn event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} focus focusin}
test validate-1.9 {entry widget validation - vmode focus} -body {
focus -force .
# update necessary to process FocusOut event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} focus focusout}
.e configure -validate all
test validate-1.10 {entry widget validation - vmode all} -body {
focus -force .e
# update necessary to process FocusIn event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} all focusin}
test validate-1.11 {entry widget validation} -body {
focus -force .
# update necessary to process FocusOut event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} all focusout}
.e configure -validate focusin
test validate-1.12 {entry widget validation} -body {
focus -force .e
# update necessary to process FocusIn event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} focusin focusin}
test validate-1.13 {entry widget validation} -body {
set ::vVals {}
focus -force .
# update necessary to process FocusOut event
update
set ::vVals
} -result {}
.e configure -validate focuso
test validate-1.14 {entry widget validation} -body {
focus -force .e
# update necessary to process FocusIn event
update
set ::vVals
} -result {}
test validate-1.15 {entry widget validation} -body {
focus -force .
# update necessary to process FocusOut event
update
set ::vVals
} -result {.e -1 -1 abcd abcd {} focusout focusout}
test validate-1.16 {entry widget validation} -body {
.e configure -validate all
list [.e validate] $::vVals
} -result {1 {.e -1 -1 abcd abcd {} all forced}}
# DIFFERENCE: core entry temporarily sets "-validate all", tile entry doesn't.
test validate-1.17 {entry widget validation} -constraints NYI -body {
.e configure -validate all
set ::e newdata
list [.e cget -validate] $::vVals
} -result {all {.e -1 -1 newdata abcd {} all forced}}
# DIFFERENCE: validation when setting linked variable NYI
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 NYI -body {
.e configure -validate all
set ::e nextdata
list [.e cget -validate] $::vVals
} -result {none {.e -1 -1 nextdata newdata {} all forced}}
# DIFFERENCE: validate when setting linked variable NYI
# DIFFERENCE: tile 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 NYI -body {
.e configure -validate all
.e validate
list [.e cget -validate] [.e get] $::vVals
} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
## This leaves validate alone because we trigger validation through the
## textvar (a write trace), and the write during validation triggers
## nothing (by definition of avoiding loops on var traces). This is
## one of those "dangerous" conditions where the user will have a
## different value in the entry widget shown as is in the textvar.
test validate-1.20 {entry widget validation} -constraints NYI -body {
.e configure -validate all
set ::e testdata
list [.e cget -validate] [.e get] $::e $::vVals
} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
# DIFFERENCE: tile entry doesn't get out of sync w/textvar
#
# 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 all
.e validate
list [.e get] $::e $::vVals
} -result {dovaldata dovaldata {.e -1 -1 testdata testdata {} all forced}}
# DIFFERENCE: core entry disables validation, tile entry does not.
destroy .e
catch {unset ::e ::vVals}
tcltest::cleanupTests