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

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

4 files changed, 174 insertions, 46 deletions

diff --git a/tests/button.test b/tests/button.test
index 309c795..24fc2dc 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: button.test,v 1.3 1999/04/16 01:51:34 stanton Exp $
+# RCS: @(#) $Id: button.test,v 1.4 2000/03/02 21:52:24 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -783,16 +783,3 @@ option clear
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvas.test b/tests/canvas.test
index 569dd6b..f02d404 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvas.test,v 1.6 1999/12/14 06:53:12 hobbs Exp $
+# RCS: @(#) $Id: canvas.test,v 1.7 2000/03/02 21:52:25 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -355,16 +355,3 @@ test canvas-10.12 {multple events bound to same tag expr} {
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/config.test b/tests/config.test
index 8fdbbd7..a12ecb5 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: config.test,v 1.2 1999/04/16 01:51:36 stanton Exp $
+# RCS: @(#) $Id: config.test,v 1.3 2000/03/02 21:52:25 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -819,21 +819,19 @@ test config-12.16 {GetObjectForOption - null values} {
 	    [.a cget -cursor] [.a cget -window]
 } {{} {} {} {} {} {} {} {}}
 
+test config-13.1 {proper cleanup of options with widget destroy} {
+    foreach type {
+	button canvas entry frame listbox menu menubutton message
+	scale scrollbar text radiobutton checkbutton
+    } {
+	destroy .w
+	$type .w -cursor crosshair
+	destroy .w	
+    }
+} {}
+
 # cleanup
 eval destroy [winfo children .]
 killTables
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
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.