import tk 8.4.0

1 files changed, 812 insertions, 0 deletions

diff --git a/tcl/tests/button.test b/tcl/tests/button.test
new file mode 100644
index 00000000000..27c46316be1
--- /dev/null
+++ b/tcl/tests/button.test
@@ -0,0 +1,812 @@
+# This file is a Tcl script to test labels, buttons, checkbuttons, and
+# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c).  It is
+# organized in the standard fashion for Tcl tests.
+#
+# 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.
+#
+# RCS: @(#) $Id$
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+proc bogusTrace args {
+    error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+option add *Button.borderWidth 2
+option add *Button.highlightThickness 2
+option add *Button.font {Helvetica -12 bold}
+
+eval image delete [image names]
+if {[testConstraint testImageType]} {
+    image create test image1
+}
+label .l -text Label
+button .b -text Button
+checkbutton .c -text Checkbutton
+radiobutton .r -text Radiobutton
+pack .l .b .c .r
+update
+set i 1
+foreach test {
+    {-activebackground #012345 #012345 non-existent
+	    {unknown color name "non-existent"} {1 1 1 1}}
+    {-activeforeground #ff0000 #ff0000 non-existent
+	    {unknown color name "non-existent"} {1 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"} {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}}
+    {-compound left left bogus {bad compound "bogus": must be bottom, center, left, none, right, or top} {1 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"}
+	    {1 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}}
+    {-offrelief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 0 1 1}}
+    {-offvalue lousy lousy {} {} {0 0 1 0}}
+    {-offvalue fantastic fantastic {} {} {0 0 1 0}}
+    {-overrelief "" "" 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 1 1 1}}
+    {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
+    {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
+    {-relief flat flat 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} {1 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]
+    set classes [lindex $test 5]
+    foreach w {.l .b .c .r} hasOption [lindex $test 5] {
+	if $hasOption {
+	    test button-1.$i {configuration options} testImageType {
+		$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} testImageType {
+		    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} testImageType {
+		list [catch {$w configure $name [lindex $test 1]} msg] $msg
+	    } "1 {unknown option \"$name\"}"
+	}
+    }
+    incr i
+}
+test button-1.$i {configuration options} {
+    .c configure -selectcolor {}
+} {}
+
+test button-3.1 {ButtonCreate - not enough cd ../unix
+} {
+    list [catch {button} msg] $msg
+} {1 {wrong # args: should be "button pathName ?options?"}}
+test button-3.2 {ButtonCreate procedure - setting label class} {
+    catch {destroy .x}
+    label .x
+    winfo class .x
+} {Label}
+test button-3.3 {ButtonCreate - setting button class} {
+    catch {destroy .x}
+    button .x
+    winfo class .x
+} {Button}
+test button-3.4 {ButtonCreate - setting checkbutton class} {
+    catch {destroy .x}
+    checkbutton .x
+    winfo class .x
+} {Checkbutton}
+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 - setting class} {
+    catch {destroy .x}
+    gorp .x
+    winfo class .x
+} {Button}
+rename gorp button
+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 - 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 - too few arguments} {
+    list [catch {.b} msg] $msg
+} {1 {wrong # args: should be ".b option ?arg arg ...?"}}
+test button-4.2 {ButtonWidgetCmd - bad option name} {
+    list [catch {.b c} msg] $msg
+} {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.5 {ButtonWidgetCmd procedure, "cget" option} {
+    list [catch {.b cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
+    .b configure -highlightthickness 3
+    .b cget -highlightthickness
+} {3}
+test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
+    catch {.l cget -disabledforeground}
+} {0}
+test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
+    catch {.b cget -disabledforeground}
+} {0}
+test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
+    list [catch {.b cget -variable} msg] $msg
+} {1 {unknown option "-variable"}}
+test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
+    catch {.c cget -variable}
+} {0}
+test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
+    list [catch {.c cget -value} msg] $msg
+} {1 {unknown option "-value"}}
+test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
+    catch {.r cget -value}
+} {0}
+test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
+    list [catch {.r cget -onvalue} msg] $msg
+} {1 {unknown option "-onvalue"}}
+test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
+    llength [.c configure]
+} {39}
+test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
+    list [catch {.b configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+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.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.18 {ButtonWidgetCmd procedure, "deselect" option} {
+    list [catch {.c deselect foo} msg] $msg
+} {1 {wrong # args: should be ".c deselect"}}
+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.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.21 {ButtonWidgetCmd procedure, "deselect" option} {
+    set value 1
+    .c d
+    set value
+} {0}
+test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
+    set value2 green
+    .r deselect
+    set value2
+} {green}
+test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
+    set value2 red
+    .r deselect
+    set value2
+} {}
+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]
+    trace vdelete value w bogusTrace
+    set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+    while executing
+".c deselect"} 0}
+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]
+    trace vdelete value2 w bogusTrace
+    set result
+} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
+    while executing
+".r deselect"} {}}
+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.27 {ButtonWidgetCmd procedure, "flash" option} {
+    list [catch {.l flash} msg] $msg
+} {1 {bad option "flash": must be cget or configure}}
+test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
+    list [catch {.b flash} msg] $msg
+} {0 {}}
+test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
+    list [catch {.c flash} msg] $msg
+} {0 {}}
+test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
+    list [catch {.r f} msg] $msg
+} {0 {}}
+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.32 {ButtonWidgetCmd procedure, "invoke" option} {
+    list [catch {.l invoke} msg] $msg
+} {1 {bad option "invoke": must be cget or configure}}
+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.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.35 {ButtonWidgetCmd procedure, "invoke" option} {
+    set value bogus
+    .c configure -command {set x invoked} -variable value -onvalue 1 \
+	    -offvalue 0
+    set x "not invoked"
+    .c invoke
+    list $x $value
+} {invoked 1}
+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.37 {ButtonWidgetCmd procedure, "select" option} {
+    list [catch {.l select} msg] $msg
+} {1 {bad option "select": must be cget or configure}}
+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.39 {ButtonWidgetCmd procedure, "select" option} {
+    list [catch {.c select foo} msg] $msg
+} {1 {wrong # args: should be ".c select"}}
+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.41 {ButtonWidgetCmd procedure, "select" option} {
+    set value2 green
+    .r configure -command {} -variable value2 -value red
+    .r select
+    set value2
+} {red}
+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]
+    trace vdelete value2 w bogusTrace
+    set result
+} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
+    while executing
+".r select"} red}
+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.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.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.46 {ButtonWidgetCmd procedure, "toggle" option} {
+    list [catch {.c toggle foo} msg] $msg
+} {1 {wrong # args: should be ".c toggle"}}
+test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
+    set value bogus
+    .c configure -command {} -variable value -onvalue sunshine -offvalue rain
+    .c toggle
+    set result $value
+    .c toggle
+    lappend result $value
+    .c toggle
+    lappend result $value
+} {sunshine rain sunshine}
+test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
+    .c configure -onvalue xyz -offvalue abc
+    set value xyz
+    trace variable value w bogusTrace
+    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
+    trace vdelete value w bogusTrace
+    set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+    while executing
+".c toggle"} abc}
+test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
+    .c configure -onvalue xyz -offvalue abc
+    set value abc
+    trace variable value w bogusTrace
+    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
+    trace vdelete value w bogusTrace
+    set result
+} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
+    while executing
+".c toggle"} xyz}
+test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
+    catch {unset value}; set value(1) 1;
+    set result [list [catch {.c toggle} msg] $msg $errorInfo]
+    unset value;
+    set result
+} {1 {can't set "value": variable is array} {can't set "value": variable is array
+    while executing
+".c toggle"}}
+
+test button-5.1 {DestroyButton procedure} testImageType {
+    image create test image1
+    button .b1 -image image1
+    button .b2 -fg #ff0000 -text "Button 2"
+    button .b3 -state active -text "Button 3"
+    button .b4 -disabledforeground #0000ff -state disabled -text "Button 4"
+    checkbutton .b5 -variable x -text "Checkbutton 5"
+    set x 1
+    pack .b1 .b2 .b3 .b4 .b5
+    update
+    deleteWindows
+} {}
+
+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
+    button .b1 -textvariable x
+    .b1 configure -textvariable y
+    set x New
+    lindex [.b1 configure -text] 4
+} {From-y}
+test button-6.2 {ConfigureButton - variable traces} {
+    catch {destroy .b1}
+    catch {unset x}
+    checkbutton .b1 -variable x
+    set x 1
+    set y 1
+    .b1 configure -textvariable y
+    set x 0
+    .b1 toggle
+    set y
+} {1}
+test button-6.3 {ConfigureButton - image handling} testImageType {
+    catch {destroy .b1}
+    eval image delete [image names]
+    image create test image1
+    image create test image2
+    button .b1 -image image1
+    image delete image1
+    .b1 configure -image image2
+    image names
+} {image2}
+test button-6.5 {ConfigureButton - default value for variable} {
+    catch {destroy .b1}
+    checkbutton .b1
+    .b1 cget -variable
+} {b1}
+test button-6.6 {ConfigureButton - setting selected state from variable} {
+    catch {destroy .b1}
+    set x 0
+    set y Shiny
+    checkbutton .b1 -variable x
+    .b1 configure -variable y -onvalue Shiny
+    .b1 toggle
+    set y
+} 0
+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 - setting selected state from variable} {
+    catch {destroy .b1}
+    catch {unset x}
+    radiobutton .b1 -variable x
+    set x
+} {}
+test button-6.9 {ConfigureButton - error in setting variable} {
+    catch {destroy .b1}
+    catch {unset x}
+    trace variable x w bogusTrace
+    set result [list [catch {radiobutton .b1 -variable x} msg] $msg]
+    trace vdelete x w bogusTrace
+    set result
+} {1 {can't set "x": trace aborted}}
+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 - 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 - 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 - variable handling} {
+    catch {destroy .b1}
+    catch {unset x}
+    trace variable x w bogusTrace
+    set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \
+	    $msg $x]
+    trace vdelete x w bogusTrace
+    set result
+} {1 {can't set "x": trace aborted} foo}
+test button-6.14 {ConfigureButton - -width option} {
+    catch {destroy .b1}
+    button .b1 -text "Button 1"
+    list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
+} {1 {expected integer but got "1i"} {expected integer but got "1i"
+    (processing -width option)
+    invoked from within
+".b1 configure -width 1i"}}
+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
+} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
+    (processing -height option)
+    invoked from within
+".b1 configure -height 0.5c"}}
+test button-6.16 {ConfigureButton - -width option} {
+    catch {destroy .b1}
+    button .b1 -bitmap questhead
+    list [catch {.b1 configure -width abc} msg] $msg $errorInfo
+} {1 {bad screen distance "abc"} {bad screen distance "abc"
+    (processing -width option)
+    invoked from within
+".b1 configure -width abc"}}
+test button-6.17 {ConfigureButton - -height option} testImageType {
+    catch {destroy .b1}
+    eval image delete [image names]
+    image create test image1
+    button .b1 -image image1
+    list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo
+} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
+    (processing -height option)
+    invoked from within
+".b1 configure -height 0.5x"}}
+test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
+    catch {destroy .b1}
+    button .b1 -text "Sample text" -width 10 -height 2
+    pack .b1
+    set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
+    .b1 configure -bitmap questhead
+    lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
+} {102 46 20 12}
+test button-6.19 {ConfigureButton - computing geometry} {
+    catch {destroy .b1}
+    button .b1 -text "Button 1"
+    set old [winfo reqwidth .b1]
+    .b1 configure -text "Much longer text"
+    set new [winfo reqwidth .b1]
+    expr $old == $new
+} {0}
+
+test button-7.1 {ButtonEventProc procedure} {
+    catch {destroy .b1}
+    button .b1 -text "Test Button" -command {
+	destroy .b1
+	set x [list [winfo exists .b1] [info commands .b1]]
+    }
+    .b1 invoke
+    set x
+} {0 {}}
+test button-7.2 {ButtonEventProc procedure} {
+    deleteWindows
+    button .b1 -bg #543210
+    rename .b1 .b2
+    set x {}
+    lappend x [winfo children .]
+    lappend x [.b2 cget -bg]
+    destroy .b1
+    lappend x [info command .b*] [winfo children .]
+} {.b1 #543210 {} {}}
+
+test button-8.1 {ButtonCmdDeletedProc procedure} {
+    deleteWindows
+    button .b1
+    rename .b1 {}
+    list [info command .b*] [winfo children .]
+} {{} {}}
+
+test button-9.1 {TkInvokeButton procedure} {
+    catch {destroy .b1}
+    set x 0
+    checkbutton .b1 -variable x
+    set result $x
+    .b1 invoke
+    lappend result $x
+    .b1 invoke
+    lappend result $x
+} {0 1 0}
+test button-9.2 {TkInvokeButton procedure} {
+    catch {destroy .b1}
+    set x 0
+    checkbutton .b1 -variable x
+    trace variable x w bogusTrace
+    set result [list [catch {.b1 invoke} msg] $msg $x]
+    trace vdelete x w bogusTrace
+    set result
+} {1 {can't set "x": trace aborted} 1}
+test button-9.3 {TkInvokeButton procedure} {
+    catch {destroy .b1}
+    set x 1
+    checkbutton .b1 -variable x
+    trace variable x w bogusTrace
+    set result [list [catch {.b1 invoke} msg] $msg $x]
+    trace vdelete x w bogusTrace
+    set result
+} {1 {can't set "x": trace aborted} 0}
+test button-9.4 {TkInvokeButton procedure} {
+    catch {destroy .b1}
+    set x 0
+    radiobutton .b1 -variable x -value red
+    set result $x
+    .b1 invoke
+    lappend result $x
+    .b1 invoke
+    lappend result $x
+} {0 red red}
+test button-9.5 {TkInvokeButton procedure} {
+    catch {destroy .b1}
+    radiobutton .b1 -variable x -value red
+    set x green
+    trace variable x w bogusTrace
+    set result [list [catch {.b1 invoke} msg] $msg $errorInfo $x]
+    trace vdelete x w bogusTrace
+    set result
+} {1 {can't set "x": trace aborted} {can't set "x": trace aborted
+    while executing
+".b1 invoke"} red}
+test button-9.6 {TkInvokeButton procedure} {
+    deleteWindows
+    set result untouched
+    button .b1 -command {set result invoked}
+    list [catch {.b1 invoke} msg] $msg $result
+} {0 invoked invoked}
+test button-9.7 {TkInvokeButton procedure} {
+    deleteWindows
+    set result untouched
+    set x 0
+    checkbutton .b1 -variable x -command {set result "invoked $x"}
+    list [catch {.b1 invoke} msg] $msg $result
+} {0 {invoked 1} {invoked 1}}
+test button-9.8 {TkInvokeButton procedure} {
+    deleteWindows
+    set result untouched
+    set x 0
+    radiobutton .b1 -variable x -value red -command {set result "invoked $x"}
+    list [catch {.b1 invoke} msg] $msg $result
+} {0 {invoked red} {invoked red}}
+
+test button-10.1 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 1
+    checkbutton .b1 -variable x
+    unset x
+    set result [info exists x]
+    .b1 toggle
+    lappend result $x
+    set x 0
+    .b1 toggle
+    lappend result $x
+} {0 1 1}
+test button-10.2 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 0
+    checkbutton .b1 -variable x
+    set x 44
+    .b1 toggle
+    set x
+} {1}
+test button-10.3 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 1
+    checkbutton .b1 -variable x
+    set x 44
+    .b1 toggle
+    set x
+} {1}
+test button-10.4 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 0
+    checkbutton .b1 -variable x
+    set x 1
+    .b1 toggle
+    set x
+} {0}
+test button-10.5 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 1
+    checkbutton .b1 -variable x
+    set x 1
+    .b1 toggle
+    set x
+} {0}
+test button-10.6 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 0
+    checkbutton .b1 -variable x
+    set x 0
+    .b1 toggle
+    set x
+} {1}
+test button-10.7 {ButtonVarProc procedure} {
+    deleteWindows
+    set x 1
+    checkbutton .b1 -variable x
+    set x 0
+    .b1 toggle
+    set x
+} {1}
+test button-10.8 {ButtonVarProc procedure, can't read variable} {
+    # This test does nothing but produce a core dump if there's a prbblem.
+    deleteWindows
+    catch {unset a}
+    checkbutton .b1 -variable a
+    unset a
+    set a(32) 0
+    unset a
+} {}
+
+test button-11.1 {ButtonTextVarProc procedure} {
+    deleteWindows
+    set x Label
+    button .b1 -textvariable x
+    unset x
+    set result [list $x [lindex [.b1 configure -text] 4]]
+    set x New
+    lappend result [lindex [.b1 configure -text] 4]
+} {Label Label New}
+test button-11.2 {ButtonTextVarProc procedure} {
+    deleteWindows
+    # Windows buttons have a default min width, so we have to
+    # set this to be longer to force the wider button.
+    set x ExtraLongLabel
+    button .b1 -textvariable x
+    set old [winfo reqwidth .b1]
+    set x New
+    set new [winfo reqwidth .b1]
+    list [lindex [.b1 configure -text] 4] [expr $old == $new]
+} {New 0}
+
+test button-12.1 {ButtonImageProc procedure} testImageType {
+    deleteWindows
+    eval image delete [image names]
+    image create test image1
+    label .b1 -image image1 -padx 0 -pady 0 -bd 0
+    pack .b1
+    set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
+    image1 changed 0 0 0 0 80 100
+    lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
+} {30 15 80 100}
+
+deleteWindows
+set l [interp hidden]
+
+test button-13.1 {button widget vs hidden commands} {
+    catch {destroy .b}
+    button .b -text hello
+    interp hide {} .b
+    destroy .b
+    list [winfo children .] [interp hidden]
+} [list {} $l]
+
+deleteWindows
+
+test button-14.1 {size behaviouor} {
+    set res {}
+    foreach class {label button radiobutton checkbutton} {
+	eval destroy [winfo children .]
+
+	$class .a -text Hej 
+	$class .b -text Hej -width 10 -height 1
+	$class .c -text "" -width 10 -height 1
+
+	for {set t 0} {$t < 2} {incr t} {
+	    set res2 {}
+	    # With -width, width should not be affected by text change
+	    lappend res2 [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}]
+	    # With -height, height should not be affected by text change
+	    lappend res2 [expr {[winfo reqheight .b] == [winfo reqheight .c]}]
+	    # A one line text should be as high as -height 1
+	    lappend res2 [expr {[winfo reqheight .a] == [winfo reqheight .b]}]
+	    lappend res $res2
+	    
+	    # Do the second round with another font
+	    .a configure -font "Arial 20"
+	    .b configure -font "Arial 20"
+	    .c configure -font "Arial 20"
+	}
+    }
+    set res
+} {{1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1}}
+
+deleteWindows
+
+option clear
+
+# cleanup
+::tcltest::cleanupTests
+return