* Merged 8.1 branch into the main trunk

FossilOrigin-Name: 1120dc4257448ed1955333e682de48e2940cc741

1 files changed, 188 insertions, 212 deletions

diff --git a/tests/button.test b/tests/button.test
index 1e36dd2..309c795 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -4,23 +4,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: button.test,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: button.test,v 1.3 1999/04/16 01:51:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\""
     puts "image, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -51,255 +51,217 @@ update
 set i 1
 foreach test {
     {-activebackground #012345 #012345 non-existent
-	    {unknown color name "non-existent"}}
+	    {unknown color name "non-existent"} {0 1 1 1}}
     {-activeforeground #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+	    {unknown color name "non-existent"} {0 1 1 1}}
+    {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
     {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-command "set x" {set x} {} {}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
-    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
-    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
-    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
-    {-height 18 18 20.0 {expected integer but got "20.0"}}
-    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
-    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
-    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
-    {-image image1 image1 bogus {image "bogus" doesn't exist}}
-    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
-    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
-    {-offvalue lousy lousy {} {}}
-    {-offvalue fantastic fantastic {} {}}
-    {-padx 12 12 420x {bad screen distance "420x"}}
-    {-pady 12 12 420x {bad screen distance "420x"}}
-    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
-    {-selectimage image1 image1 bogus {image "bogus" doesn't exist}}
-    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
-    {-takefocus "any string" "any string" {} {}}
-    {-text "Sample text" {Sample text} {} {}}
-    {-textvariable i i {} {}}
-    {-underline 5 5 3p {expected integer but got "3p"}}
-    {-width 402 402 3p {expected integer but got "3p"}}
-    {-wraplength 100 100 6x {bad screen distance "6x"}}
+	    {unknown color name "non-existent"} {1 1 1 1}}
+    {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
+    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}
+	    {1 1 1 1}}
+    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
+	    {1 1 1 1}}
+    {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
+    {-command "set x" {set x} {} {} {0 1 1 1}}
+    {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
+    {-default active active huh?
+	    {bad default "huh?": must be active, disabled, or normal}
+	    {0 1 0 0}}
+    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
+	    {0 1 1 1}}
+    {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}}
+    {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+    {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}}
+    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}
+	    {1 1 1 1}}
+    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}
+	    {1 1 1 1}}
+    {-highlightthickness 6m 6m badValue {bad screen distance "badValue"}
+	    {1 1 1 1}}
+    {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
+    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
+	    {0 0 1 1}}
+    {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
+    {-offvalue lousy lousy {} {} {0 0 1 0}}
+    {-offvalue fantastic fantastic {} {} {0 0 1 0}}
+    {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
+    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
+    {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
+    {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {0 1 1 1}}
+    {-takefocus "any string" "any string" {} {} {1 1 1 1}}
+    {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
+    {-textvariable i i {} {} {1 1 1 1}}
+    {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
+    {-value anyString anyString {} {} {0 0 0 1}}
+    {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
+    {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
 } {
     set name [lindex $test 0]
-    test button-1.$i {configuration options} {
-	.c configure $name [lindex $test 1]
-	lindex [.c configure $name] 4
-    } [lindex $test 2]
-    incr i
-    if {[lindex $test 3] != ""} {
-	test button-1.$i {configuration options} {
-	    list [catch {.c configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    set classes [lindex $test 5]
+    foreach w {.l .b .c .r} hasOption [lindex $test 5] {
+	if $hasOption {
+	    test button-1.$i {configuration options} {
+		$w configure $name [lindex $test 1]
+		lindex [$w configure $name] 4
+	    } [lindex $test 2]
+	    incr i
+	    if {[lindex $test 3] != ""} {
+		test button-1.$i {configuration options} {
+		    list [catch {$w configure $name [lindex $test 3]} msg] $msg
+		} [list 1 [lindex $test 4]]
+	    }
+	    $w configure $name [lindex [$w configure $name] 3]
+	} else {
+	    test button-1.$i {configuration options} {
+		list [catch {$w configure $name [lindex $test 1]} msg] $msg
+	    } "1 {unknown option \"$name\"}"
+	}
     }
-    .c configure $name [lindex [.c configure $name] 3]
     incr i
 }
 test button-1.$i {configuration options} {
     .c configure -selectcolor {}
 } {}
 incr i
-# the following tests only work on buttons, not checkbuttons
-test button-1.$i {configuration options} {
-    .b configure -default active
-    lindex [.b configure -default] 4
-} active
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default normal
-    lindex [.b configure -default] 4
-} normal
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default disabled
-    lindex [.b configure -default] 4
-} disabled
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default active
-    lindex [.b configure -default] 3
-} disabled
-incr i
-test button-1.$i {configuration options} {
-    list [catch {.b configure -default no_way} msg] $msg
-} {1 {bad -default value "no_way": must be normal, active, or disabled}}
 
-set i 1
-foreach check {
-    {-activebackground 1 0 0 0}
-    {-activeforeground 1 0 0 0}
-    {-anchor 0 0 0 0}
-    {-background 0 0 0 0}
-    {-bd 0 0 0 0}
-    {-bg 0 0 0 0}
-    {-bitmap 0 0 0 0}
-    {-borderwidth 0 0 0 0}
-    {-command 1 0 0 0}
-    {-cursor 0 0 0 0}
-    {-default 1 0 1 1}
-    {-disabledforeground 1 0 0 0}
-    {-fg 0 0 0 0}
-    {-font 0 0 0 0}
-    {-foreground 0 0 0 0}
-    {-height 0 0 0 0}
-    {-image 0 0 0 0}
-    {-indicatoron 1 1 0 0}
-    {-offvalue 1 1 0 1}
-    {-onvalue 1 1 0 1}
-    {-padx 0 0 0 0}
-    {-pady 0 0 0 0}
-    {-relief 0 0 0 0}
-    {-selectcolor 1 1 0 0}
-    {-selectimage 1 1 0 0}
-    {-state 1 0 0 0}
-    {-text 0 0 0 0}
-    {-textvariable 0 0 0 0}
-    {-value 1 1 1 0}
-    {-variable 1 1 0 0}
-    {-width 0 0 0 0}
+test button-3.1 {ButtonCreate - not enough cd ../unix
 } {
-    test button-2.$i {label-specific options} "
-	catch {.l configure [lindex $check 0]}
-    " [lindex $check 1]
-    incr i
-    test button-2.$i {button-specific options} "
-	catch {.b configure [lindex $check 0]}
-    " [lindex $check 2]
-    incr i
-    test button-2.$i {checkbutton-specific options} "
-	catch {.c configure [lindex $check 0]}
-    " [lindex $check 3]
-    incr i
-    test button-2.$i {radiobutton-specific options} "
-	catch {.r configure [lindex $check 0]}
-    " [lindex $check 4]
-    incr i
-}
-
-test button-3.1 {ButtonCreate procedure} {
     list [catch {button} msg] $msg
 } {1 {wrong # args: should be "button pathName ?options?"}}
-test button-3.2 {ButtonCreate procedure} {
+test button-3.2 {ButtonCreate procedure - setting label class} {
     catch {destroy .x}
     label .x
     winfo class .x
 } {Label}
-test button-3.3 {ButtonCreate procedure} {
+test button-3.3 {ButtonCreate - setting button class} {
     catch {destroy .x}
     button .x
     winfo class .x
 } {Button}
-test button-3.4 {ButtonCreate procedure} {
+test button-3.4 {ButtonCreate - setting checkbutton class} {
     catch {destroy .x}
     checkbutton .x
     winfo class .x
 } {Checkbutton}
-test button-3.5 {ButtonCreate procedure} {
+test button-3.5 {ButtonCreate - setting radiobutton class} {
     catch {destroy .x}
     radiobutton .x
     winfo class .x
 } {Radiobutton}
 rename button gorp
-test button-3.6 {ButtonCreate procedure} {
+test button-3.6 {ButtonCreate - setting class} {
     catch {destroy .x}
     gorp .x
     winfo class .x
 } {Button}
 rename gorp button
-test button-3.7 {ButtonCreate procedure} {
+test button-3.7 {ButtonCreate - bad window name} {
     list [catch {button foo} msg] $msg
 } {1 {bad window path name "foo"}}
-test button-3.8 {ButtonCreate procedure} {
+test button-3.8 {ButtonCreate procedure - error in default option value} {
+    catch {destroy .funny}
+    option add *funny.background bogus
+    list [catch {button .funny} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+    (database entry for "-background" in widget ".funny")
+    invoked from within
+"button .funny"}}
+test button-3.9 {ButtonCreate procedure - option error} {
     catch {destroy .x}
     list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
 } {1 {unknown option "-gorp"} 0}
+test button-3.10 {ButtonCreate procedure - return value} {
+    catch {destroy .abcd}
+    set x [button .abcd]
+    destroy .abc
+    set x
+} {.abcd}
 
-test button-4.1 {ButtonWidgetCmd procedure} {
+test button-4.1 {ButtonWidgetCmd - too few arguments} {
     list [catch {.b} msg] $msg
 } {1 {wrong # args: should be ".b option ?arg arg ...?"}}
-test button-4.2 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.2 {ButtonWidgetCmd - bad option name} {
     list [catch {.b c} msg] $msg
-} {1 {bad option "c": must be cget, configure, flash, or invoke}}
-test button-4.3 {ButtonWidgetCmd procedure, "cget" option} {
+} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}}
+test button-4.3 {ButtonWidgetCmd - bad option name} {
+    list [catch {.b bogus} msg] $msg
+} {1 {bad option "bogus": must be cget, configure, flash, or invoke}}
+test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget a b} msg] $msg
 } {1 {wrong # args: should be ".b cget option"}}
-test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
-test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
     .b configure -highlightthickness 3
     .b cget -highlightthickness
 } {3}
-test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.l cget -disabledforeground} msg] $msg
 } {1 {unknown option "-disabledforeground"}}
-test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.b cget -disabledforeground}
 } {0}
-test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget -variable} msg] $msg
 } {1 {unknown option "-variable"}}
-test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.c cget -variable}
 } {0}
-test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.c cget -value} msg] $msg
 } {1 {unknown option "-value"}}
-test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.r cget -value}
 } {0}
-test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.r cget -onvalue} msg] $msg
 } {1 {unknown option "-onvalue"}}
-test button-4.13 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
     llength [.c configure]
 } {36}
-test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
     list [catch {.b configure -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
-test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
     list [catch {.b co -bg #ffffff -fg} msg] $msg
 } {1 {value for "-fg" missing}}
-test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.17 {ButtonWidgetCmd procedure, "configure" option} {
     .b configure -fg #123456
     .b configure -bg #654321
     lindex [.b configure -fg] 4
 } {#123456}
 .c configure -variable value -onvalue 1 -offvalue 0
 .r configure -variable value2 -value red
-test button-4.17 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.c deselect foo} msg] $msg
 } {1 {wrong # args: should be ".c deselect"}}
-test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.l deselect} msg] $msg
 } {1 {bad option "deselect": must be cget or configure}}
-test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.b deselect} msg] $msg
 } {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
-test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
     set value 1
     .c d
     set value
 } {0}
-test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 green
     .r deselect
     set value2
 } {green}
-test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 red
     .r deselect
     set value2
 } {}
-test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
     set value 1
     trace variable value w bogusTrace
     set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
@@ -308,7 +270,7 @@ test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c deselect"} 0}
-test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 red
     trace variable value2 w bogusTrace
     set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
@@ -317,40 +279,40 @@ test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
 } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
     while executing
 ".r deselect"} {}}
-test button-4.25 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.b flash foo} msg] $msg
 } {1 {wrong # args: should be ".b flash"}}
-test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.l flash} msg] $msg
 } {1 {bad option "flash": must be cget or configure}}
-test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.b flash} msg] $msg
 } {0 {}}
-test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.c flash} msg] $msg
 } {0 {}}
-test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.r f} msg] $msg
 } {0 {}}
-test button-4.30 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
     list [catch {.b invoke foo} msg] $msg
 } {1 {wrong # args: should be ".b invoke"}}
-test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
     list [catch {.l invoke} msg] $msg
 } {1 {bad option "invoke": must be cget or configure}}
-test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
     .b configure -command {set x invoked}
     set x "not invoked"
     .b invoke
     set x
 } {invoked}
-test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
     .b configure -command {set x invoked} -state disabled
     set x "not invoked"
     .b invoke
     set x
 } {not invoked}
-test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
     set value bogus
     .c configure -command {set x invoked} -variable value -onvalue 1 \
 	    -offvalue 0
@@ -358,35 +320,35 @@ test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
     .c invoke
     list $x $value
 } {invoked 1}
-test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} {
     set value2 green
     .r configure -command {set x invoked} -variable value2 -value red
     set x "not invoked"
     .r i
     list $x $value2
 } {invoked red}
-test button-4.36 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.l select} msg] $msg
 } {1 {bad option "select": must be cget or configure}}
-test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.b select} msg] $msg
 } {1 {bad option "select": must be cget, configure, flash, or invoke}}
-test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.c select foo} msg] $msg
 } {1 {wrong # args: should be ".c select"}}
-test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
     set value bogus
     .c configure -command {} -variable value -onvalue lovely -offvalue 0
     .c s
     set value
 } {lovely}
-test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
     set value2 green
     .r configure -command {} -variable value2 -value red
     .r select
     set value2
 } {red}
-test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.42 {ButtonWidgetCmd procedure, "select" option} {
     set value2 yellow
     trace variable value2 w bogusTrace
     set result [list [catch {.r select} msg] $msg $errorInfo $value2]
@@ -395,19 +357,19 @@ test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
 } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
     while executing
 ".r select"} red}
-test button-4.42 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.l toggle} msg] $msg
 } {1 {bad option "toggle": must be cget or configure}}
-test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.b toggle} msg] $msg
 } {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
-test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.r toggle} msg] $msg
 } {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
-test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.c toggle foo} msg] $msg
 } {1 {wrong # args: should be ".c toggle"}}
-test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
     set value bogus
     .c configure -command {} -variable value -onvalue sunshine -offvalue rain
     .c toggle
@@ -417,7 +379,7 @@ test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
     .c toggle
     lappend result $value
 } {sunshine rain sunshine}
-test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
     .c configure -onvalue xyz -offvalue abc
     set value xyz
     trace variable value w bogusTrace
@@ -427,7 +389,7 @@ test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c toggle"} abc}
-test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
     .c configure -onvalue xyz -offvalue abc
     set value abc
     trace variable value w bogusTrace
@@ -437,9 +399,6 @@ test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c toggle"} xyz}
-test button-4.49 {ButtonWidgetCmd procedure} {
-    list [catch {.c bad_option} msg] $msg
-} {1 {bad option "bad_option": must be cget, configure, deselect, flash, invoke, select, or toggle}}
 test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
     catch {unset value}; set value(1) 1;
     set result [list [catch {.c toggle} msg] $msg $errorInfo]
@@ -462,7 +421,14 @@ test button-5.1 {DestroyButton procedure} {
     eval destroy [winfo children .]
 } {}
 
-test button-6.1 {ConfigureButton procedure} {
+test button-6.1 {ConfigureButton - textvariable trace} {
+    catch {destroy .b1}
+    button .b1 -bd 4 -bg green
+    catch {.b1 configure -bd 7 -bg green -fg bogus}
+    list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \
+	    $msg [.b1 cget -bd] [.b1 cget -bg]
+} {1 {unknown color name "bogus"} 4 green}
+test button-6.2 {ConfigureButton - textvariable trace} {
     catch {destroy .b1}
     set x From-x
     set y From-y
@@ -471,7 +437,7 @@ test button-6.1 {ConfigureButton procedure} {
     set x New
     lindex [.b1 configure -text] 4
 } {From-y}
-test button-6.2 {ConfigureButton procedure} {
+test button-6.2 {ConfigureButton - variable traces} {
     catch {destroy .b1}
     catch {unset x}
     checkbutton .b1 -variable x
@@ -482,7 +448,7 @@ test button-6.2 {ConfigureButton procedure} {
     .b1 toggle
     set y
 } {1}
-test button-6.3 {ConfigureButton procedure} {
+test button-6.3 {ConfigureButton - image handling} {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -492,18 +458,12 @@ test button-6.3 {ConfigureButton procedure} {
     .b1 configure -image image2
     image names
 } {image2}
-test button-6.4 {ConfigureButton procedure} {
-    catch {destroy .b1}
-    button .b1 -text "Test" -state disabled
-    list [catch {.b1 configure -state bogus} msg] $msg \
-	    [lindex [.b1 configure -state] 4]
-} {1 {bad state value "bogus": must be normal, active, or disabled} normal}
-test button-6.5 {ConfigureButton procedure} {
+test button-6.5 {ConfigureButton - default value for variable} {
     catch {destroy .b1}
     checkbutton .b1
     .b1 cget -variable
 } {b1}
-test button-6.6 {ConfigureButton procedure} {
+test button-6.6 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     set x 0
     set y Shiny
@@ -512,19 +472,19 @@ test button-6.6 {ConfigureButton procedure} {
     .b1 toggle
     set y
 } 0
-test button-6.7 {ConfigureButton procedure} {
+test button-6.7 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     catch {unset x}
     checkbutton .b1 -variable x -offvalue Bogus
     set x
 } Bogus
-test button-6.8 {ConfigureButton procedure} {
+test button-6.8 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     catch {unset x}
     radiobutton .b1 -variable x
     set x
 } {}
-test button-6.9 {ConfigureButton procedure} {
+test button-6.9 {ConfigureButton - error in setting variable} {
     catch {destroy .b1}
     catch {unset x}
     trace variable x w bogusTrace
@@ -532,23 +492,23 @@ test button-6.9 {ConfigureButton procedure} {
     trace vdelete x w bogusTrace
     set result
 } {1 {can't set "x": trace aborted}}
-test button-6.10 {ConfigureButton procedure} {
+test button-6.10 {ConfigureButton - bad image name} {
     catch {destroy .b1}
     list [catch {button .b1 -image bogus} msg] $msg
 } {1 {image "bogus" doesn't exist}}
-test button-6.11 {ConfigureButton procedure} {
+test button-6.11 {ConfigureButton - setting variable from current text value} {
     catch {destroy .b1}
     catch {unset x}
     button .b1 -textvariable x -text "Button 1"
     set x
 } {Button 1}
-test button-6.12 {ConfigureButton procedure} {
+test button-6.12 {ConfigureButton - using current value of variable} {
     catch {destroy .b1}
     set x Override
     button .b1 -textvariable x -text "Button 1"
     set x
 } {Override}
-test button-6.13 {ConfigureButton procedure} {
+test button-6.13 {ConfigureButton - variable handling} {
     catch {destroy .b1}
     catch {unset x}
     trace variable x w bogusTrace
@@ -557,7 +517,7 @@ test button-6.13 {ConfigureButton procedure} {
     trace vdelete x w bogusTrace
     set result
 } {1 {can't set "x": trace aborted} foo}
-test button-6.14 {ConfigureButton procedure} {
+test button-6.14 {ConfigureButton - -width option} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
@@ -565,7 +525,7 @@ test button-6.14 {ConfigureButton procedure} {
     (processing -width option)
     invoked from within
 ".b1 configure -width 1i"}}
-test button-6.15 {ConfigureButton procedure} {
+test button-6.15 {ConfigureButton - -height option} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
@@ -573,7 +533,7 @@ test button-6.15 {ConfigureButton procedure} {
     (processing -height option)
     invoked from within
 ".b1 configure -height 0.5c"}}
-test button-6.16 {ConfigureButton procedure} {
+test button-6.16 {ConfigureButton - -width option} {
     catch {destroy .b1}
     button .b1 -bitmap questhead
     list [catch {.b1 configure -width abc} msg] $msg $errorInfo
@@ -581,7 +541,7 @@ test button-6.16 {ConfigureButton procedure} {
     (processing -width option)
     invoked from within
 ".b1 configure -width abc"}}
-test button-6.17 {ConfigureButton procedure} {
+test button-6.17 {ConfigureButton - -height option} {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -591,7 +551,7 @@ test button-6.17 {ConfigureButton procedure} {
     (processing -height option)
     invoked from within
 ".b1 configure -height 0.5x"}}
-test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
+test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
     catch {destroy .b1}
     button .b1 -text "Sample text" -width 10 -height 2
     pack .b1
@@ -599,7 +559,7 @@ test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
     .b1 configure -bitmap questhead
     lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
 } {102 46 20 12}
-test button-6.19 {ConfigureButton procedure} {
+test button-6.19 {ConfigureButton - computing geometry} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     set old [winfo reqwidth .b1]
@@ -820,3 +780,19 @@ eval destroy [winfo children .]
 
 option clear
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+