diff options
author | hobbs <hobbs> | 2006-10-31 01:42:25 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2006-10-31 01:42:25 (GMT) |
commit | 397a2c9832bf618f26be267501cf49ab06a562ec (patch) | |
tree | 61d5e957eccfcba57b0dd27ebc73db085385834e /tests/ttk/validate.test | |
parent | 18d330543869e240c2bd12fc9fbb8d5027f5cad6 (diff) | |
download | tk-397a2c9832bf618f26be267501cf49ab06a562ec.zip tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.gz tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.bz2 |
* doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n:
* doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n:
* doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n:
* doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n:
* doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n:
* doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n:
* doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n:
* doc/ttk_treeview.n, doc/ttk_widget.n,:
* generic/ttk/ttk.decls, generic/ttk/ttkBlink.c:
* generic/ttk/ttkButton.c, generic/ttk/ttkCache.c:
* generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c:
* generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c:
* generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c:
* generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c:
* generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c:
* generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c:
* generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c:
* generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c:
* generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c:
* generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c:
* generic/ttk/ttkSquare.c, generic/ttk/ttkState.c:
* generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c:
* generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c:
* generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h:
* generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c:
* generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c:
* generic/ttk/ttkWidget.h:
* library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl:
* library/demos/ttk_repeater.tcl:
* library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl:
* library/ttk/button.tcl, library/ttk/clamTheme.tcl:
* library/ttk/classicTheme.tcl, library/ttk/combobox.tcl:
* library/ttk/cursors.tcl, library/ttk/defaults.tcl:
* library/ttk/dialog.tcl, library/ttk/entry.tcl:
* library/ttk/fonts.tcl, library/ttk/icons.tcl:
* library/ttk/keynav.tcl, library/ttk/menubutton.tcl:
* library/ttk/notebook.tcl, library/ttk/panedwindow.tcl:
* library/ttk/progress.tcl, library/ttk/scale.tcl:
* library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl:
* library/ttk/treeview.tcl, library/ttk/ttk.tcl:
* library/ttk/utils.tcl, library/ttk/winTheme.tcl:
* library/ttk/xpTheme.tcl:
* macosx/ttkMacOSXTheme.c:
* tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test:
* tests/ttk/entry.test, tests/ttk/image.test:
* tests/ttk/labelframe.test, tests/ttk/layout.test:
* tests/ttk/misc.test, tests/ttk/notebook.test:
* tests/ttk/panedwindow.test, tests/ttk/progressbar.test:
* tests/ttk/scrollbar.test, tests/ttk/treetags.test:
* tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test:
* win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c:
First import of Ttk themed Tk widgets as branched from tile 0.7.8
* generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy
tk classic widgets to ::tk namespace.
* library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library.
* unix/Makefile.in, win/Makefile.in: add Ttk build bits
* win/configure, win/configure.in: check for uxtheme.h (XP theme).
Diffstat (limited to 'tests/ttk/validate.test')
-rw-r--r-- | tests/ttk/validate.test | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test new file mode 100644 index 0000000..417deac --- /dev/null +++ b/tests/ttk/validate.test @@ -0,0 +1,277 @@ +## +## Entry widget validation tests +## Derived from core test suite entry-19.1 through entry-19.20 +## + +package require Tk 8.5 +package require tcltest 2.1 +namespace import -force tcltest::* + +loadTestedCommands + +testConstraint ttkEntry 1 +testConstraint coreEntry [expr {![testConstraint ttkEntry]}] + +eval tcltest::configure $argv + +test validate-0.0 "Setup" -constraints ttkEntry -body { + rename entry {} + interp alias {} entry {} ttk::entry + 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} + +# 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 +} -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 +} -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 +} -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 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. + +# 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 +} -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 all + .e validate + list [.e get] $::e $::vVals +} -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} + +# See bug #1236979 + +test validate-2.2 "configure in -validatecommand" -body { + proc validate-2.2 {win str} { + $win configure -foreground black + return 1 + } + ttk::entry .e -textvariable var -validatecommand {validate-2.2 %W %P} + .e validate +} -result 1 -cleanup { destroy .e } + + +### invalid state behavior +# + +test validate-3.0 "Setup" -body { + set ::E "123" + ttk::entry .e \ + -validatecommand {string is integer -strict %P} \ + -validate all \ + -textvariable ::E \ + ; + return [list [.e get] [.e state]] +} -result [list 123 {}] + +test validate-3.1 "insert - valid" -body { + .e insert end "4" + return [list [.e get] [.e state]] +} -result [list 1234 {}] + +test validate-3.2 "insert - invalid" -body { + .e insert end "X" + return [list [.e get] [.e state]] +} -result [list 1234 {}] + +test validate-3.3 "force invalid value" -body { + append ::E "XY" + return [list [.e get] [.e state]] +} -result [list 1234XY {}] + +test validate-3.4 "revalidate" -body { + return [list [.e validate] [.e get] [.e state]] +} -result [list 0 1234XY {invalid}] + +testConstraint NA 0 +# the next two tests (used to) exercise validation lockout protection -- +# if the widget is currently invalid, all edits are allowed. +# This behavior is currently disabled. +# +test validate-3.5 "all edits allowed while invalid" -constraints NA -body { + .e delete 4 + return [list [.e get] [.e state]] +} -result [list 1234Y {invalid}] + +test validate-3.6 "...until the value becomes valid" -constraints NA -body { + .e delete 4 + return [list [.e get] [.e state]] +} -result [list 1234 {}] + +test validate-3.last "Cleanup" -body { destroy .e } + + +### +tcltest::cleanupTests |