diff options
Diffstat (limited to 'tests/button.test')
| -rw-r--r-- | tests/button.test | 400 |
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 + + + + + + + + + + + + + |