summaryrefslogtreecommitdiffstats
path: root/tests/entry.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/entry.test')
-rw-r--r--tests/entry.test164
1 files changed, 160 insertions, 4 deletions
diff --git a/tests/entry.test b/tests/entry.test
index bb0c19c..f90e5b4 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: entry.test,v 1.5 1999/12/21 23:55:54 hobbs Exp $
+# RCS: @(#) $Id: entry.test,v 1.6 2000/03/02 21:52:26 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -1329,7 +1329,7 @@ test entry-17.3 {EntryUpdateScrollbar procedure} {
set scrollInfo
} {0.315789 0.842105}
test entry-17.4 {EntryUpdateScrollbar procedure} {
- catch {destroy .e}
+ destroy .e
proc bgerror msg {
global x
set x $msg
@@ -1348,13 +1348,169 @@ set l [interp hidden]
eval destroy [winfo children .]
test entry-18.1 {Entry widget vs hiding} {
- catch {destroy .e}
+ destroy .e
entry .e
interp hide {} .e
destroy .e
list [winfo children .] [interp hidden]
} [list {} $l]
-
+
+##
+## Entry widget VALIDATION tests
+##
+
+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 \
+ -background red -foreground white
+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 entry-19.1 {entry widget validation} {
+ .e insert 0 a
+ set ::vVals
+} {.e 1 0 a {} a all key}
+test entry-19.2 {entry widget validation} {
+ .e insert 1 b
+ set ::vVals
+} {.e 1 1 ab a b all key}
+test entry-19.3 {entry widget validation} {
+ .e insert end c
+ set ::vVals
+} {.e 1 2 abc ab c all key}
+test entry-19.4 {entry widget validation} {
+ .e insert 1 123
+ list $::vVals $::e
+} {{.e 1 1 a123bc abc 123 all key} a123bc}
+test entry-19.5 {entry widget validation} {
+ .e delete 2
+ set ::vVals
+} {.e 0 2 a13bc a123bc 2 all key}
+test entry-19.6 {entry widget validation} {
+ .e configure -validate key
+ .e delete 1 3
+ set ::vVals
+} {.e 0 1 abc a13bc 13 key key}
+test entry-19.7 {entry widget validation} {
+ set ::vVals {}
+ .e configure -validate focus
+ .e insert end d
+ set ::vVals
+} {}
+test entry-19.8 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusin}
+test entry-19.9 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focus focusout}
+.e configure -validate all
+test entry-19.10 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusin}
+test entry-19.11 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} all focusout}
+.e configure -validate focusin
+test entry-19.12 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusin focusin}
+test entry-19.13 {entry widget validation} {
+ set ::vVals {}
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {}
+.e configure -validate focuso
+test entry-19.14 {entry widget validation} {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} {}
+test entry-19.15 {entry widget validation} {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} {.e -1 -1 abcd abcd {} focusout focusout}
+test entry-19.16 {entry widget validation} {
+ list [.e validate] $::vVals
+} {1 {.e -1 -1 abcd abcd {} all forced}}
+test entry-19.17 {entry widget validation} {
+ set ::e newdata
+ list [.e cget -validate] $::vVals
+} {focusout {.e -1 -1 newdata abcd {} focusout forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 0
+}
+.e configure -validate all
+
+test entry-19.18 {entry widget validation} {
+ set ::e nextdata
+ list [.e cget -validate] $::vVals
+} {none {.e -1 -1 nextdata newdata {} all forced}}
+
+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
+}
+.e configure -validate all
+
+## 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 entry-19.19 {entry widget validation} {
+ .e validate
+ list [.e cget -validate] [.e get] $::vVals
+} {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+
+.e configure -validate all
+
+## 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 entry-19.20 {entry widget validation} {
+ set ::e testdata
+ list [.e cget -validate] [.e get] $::e $::vVals
+} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+destroy .e
+catch {unset ::e ::vVals}
+
+##
+## End validation tests
+##
+
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.