* tests/config.test: extra test to check object cleanup when

	destroying the widget
	* tests/entry.test: added test suite for entry validation

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.