开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
button.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：27k
源码类别：

通讯编程

开发平台：

Visual C++

button.test：源码内容
  1. # This file is a Tcl script to test labels, buttons, checkbuttons, and
  2. # radiobuttons in Tk (i.e., all the widgets defined in tkButton.c).  It is
  3. # organized in the standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  7. # Copyright (c) 1998-1999 by Scriptics Corporation.
  8. # All rights reserved.
  9. #
  10. # RCS: @(#) $Id: button.test,v 1.13 2002/09/02 23:32:35 hobbs Exp $
  12. package require tcltest 2.1
  13. namespace import -force tcltest::configure
  14. namespace import -force tcltest::testsDirectory
  15. configure -testdir [file join [pwd] [file dirname [info script]]]
  16. configure -loadfile [file join [testsDirectory] constraints.tcl]
  17. tcltest::loadTestedCommands
  19. proc bogusTrace args {
  20.     error "trace aborted"
  21. }
  22. catch {unset value}
  23. catch {unset value2}
  25. # Create entries in the option database to be sure that geometry options
  26. # like border width have predictable values.
  28. option add *Button.borderWidth 2
  29. option add *Button.highlightThickness 2
  30. option add *Button.font {Helvetica -12 bold}
  32. eval image delete [image names]
  33. if {[testConstraint testImageType]} {
  34.     image create test image1
  35. }
  36. label .l -text Label
  37. button .b -text Button
  38. checkbutton .c -text Checkbutton
  39. radiobutton .r -text Radiobutton
  40. pack .l .b .c .r
  41. update
  42. set i 1
  43. foreach test {
  44.     {-activebackground #012345 #012345 non-existent
  45.     {unknown color name "non-existent"} {1 1 1 1}}
  46.     {-activeforeground #ff0000 #ff0000 non-existent
  47.     {unknown color name "non-existent"} {1 1 1 1}}
  48.     {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
  49.     {-background #ff0000 #ff0000 non-existent
  50.     {unknown color name "non-existent"} {1 1 1 1}}
  51.     {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
  52.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}
  53.     {1 1 1 1}}
  54.     {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
  55.     {1 1 1 1}}
  56.     {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
  57.     {-command "set x" {set x} {} {} {0 1 1 1}}
  58.     {-compound left left bogus {bad compound "bogus": must be bottom, center, left, none, right, or top} {1 1 1 1}}
  59.     {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
  60.     {-default active active huh?
  61.     {bad default "huh?": must be active, disabled, or normal}
  62.     {0 1 0 0}}
  63.     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
  64.     {1 1 1 1}}
  65.     {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
  66.     {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}}
  67.     {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
  68.     {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}}
  69.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}
  70.     {1 1 1 1}}
  71.     {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}
  72.     {1 1 1 1}}
  73.     {-highlightthickness 6m 6m badValue {bad screen distance "badValue"}
  74.     {1 1 1 1}}
  75.     {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
  76.     {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
  77.     {0 0 1 1}}
  78.     {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
  79.     {-offrelief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 0 1 1}}
  80.     {-offvalue lousy lousy {} {} {0 0 1 0}}
  81.     {-offvalue fantastic fantastic {} {} {0 0 1 0}}
  82.     {-overrelief "" "" 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 1 1 1}}
  83.     {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
  84.     {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
  85.     {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
  86.     {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
  87.     {-relief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
  88.     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
  89.     {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
  90.     {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {1 1 1 1}}
  91.     {-takefocus "any string" "any string" {} {} {1 1 1 1}}
  92.     {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
  93.     {-textvariable i i {} {} {1 1 1 1}}
  94.     {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
  95.     {-value anyString anyString {} {} {0 0 0 1}}
  96.     {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
  97.     {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
  98. } {
  99.     set name [lindex $test 0]
  100.     set classes [lindex $test 5]
  101.     foreach w {.l .b .c .r} hasOption [lindex $test 5] {
  102. if $hasOption {
  103.     test button-1.$i {configuration options} testImageType {
  104. $w configure $name [lindex $test 1]
  105. lindex [$w configure $name] 4
  106.     } [lindex $test 2]
  107.     incr i
  108.     if {[lindex $test 3] != ""} {
  109. test button-1.$i {configuration options} testImageType {
  110.     list [catch {$w configure $name [lindex $test 3]} msg] $msg
  111. } [list 1 [lindex $test 4]]
  112.     }
  113.     $w configure $name [lindex [$w configure $name] 3]
  114. } else {
  115.     test button-1.$i {configuration options} testImageType {
  116. list [catch {$w configure $name [lindex $test 1]} msg] $msg
  117.     } "1 {unknown option "$name"}"
  118. }
  119.     }
  120.     incr i
  121. }
  122. test button-1.$i {configuration options} {
  123.     .c configure -selectcolor {}
  124. } {}
  126. test button-3.1 {ButtonCreate - not enough cd ../unix
  127. } {
  128.     list [catch {button} msg] $msg
  129. } {1 {wrong # args: should be "button pathName ?options?"}}
  130. test button-3.2 {ButtonCreate procedure - setting label class} {
  131.     catch {destroy .x}
  132.     label .x
  133.     winfo class .x
  134. } {Label}
  135. test button-3.3 {ButtonCreate - setting button class} {
  136.     catch {destroy .x}
  137.     button .x
  138.     winfo class .x
  139. } {Button}
  140. test button-3.4 {ButtonCreate - setting checkbutton class} {
  141.     catch {destroy .x}
  142.     checkbutton .x
  143.     winfo class .x
  144. } {Checkbutton}
  145. test button-3.5 {ButtonCreate - setting radiobutton class} {
  146.     catch {destroy .x}
  147.     radiobutton .x
  148.     winfo class .x
  149. } {Radiobutton}
  150. rename button gorp
  151. test button-3.6 {ButtonCreate - setting class} {
  152.     catch {destroy .x}
  153.     gorp .x
  154.     winfo class .x
  155. } {Button}
  156. rename gorp button
  157. test button-3.7 {ButtonCreate - bad window name} {
  158.     list [catch {button foo} msg] $msg
  159. } {1 {bad window path name "foo"}}
  160. test button-3.8 {ButtonCreate procedure - error in default option value} {
  161.     catch {destroy .funny}
  162.     option add *funny.background bogus
  163.     list [catch {button .funny} msg] $msg $errorInfo
  164. } {1 {unknown color name "bogus"} {unknown color name "bogus"
  165.     (database entry for "-background" in widget ".funny")
  166.     invoked from within
  167. "button .funny"}}
  168. test button-3.9 {ButtonCreate procedure - option error} {
  169.     catch {destroy .x}
  170.     list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
  171. } {1 {unknown option "-gorp"} 0}
  172. test button-3.10 {ButtonCreate procedure - return value} {
  173.     catch {destroy .abcd}
  174.     set x [button .abcd]
  175.     destroy .abc
  176.     set x
  177. } {.abcd}
  179. test button-4.1 {ButtonWidgetCmd - too few arguments} {
  180.     list [catch {.b} msg] $msg
  181. } {1 {wrong # args: should be ".b option ?arg arg ...?"}}
  182. test button-4.2 {ButtonWidgetCmd - bad option name} {
  183.     list [catch {.b c} msg] $msg
  184. } {1 {ambiguous option "c": must be cget, configure, flash, or invoke}}
  185. test button-4.3 {ButtonWidgetCmd - bad option name} {
  186.     list [catch {.b bogus} msg] $msg
  187. } {1 {bad option "bogus": must be cget, configure, flash, or invoke}}
  188. test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
  189.     list [catch {.b cget a b} msg] $msg
  190. } {1 {wrong # args: should be ".b cget option"}}
  191. test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
  192.     list [catch {.b cget -gorp} msg] $msg
  193. } {1 {unknown option "-gorp"}}
  194. test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
  195.     .b configure -highlightthickness 3
  196.     .b cget -highlightthickness
  197. } {3}
  198. test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
  199.     catch {.l cget -disabledforeground}
  200. } {0}
  201. test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
  202.     catch {.b cget -disabledforeground}
  203. } {0}
  204. test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
  205.     list [catch {.b cget -variable} msg] $msg
  206. } {1 {unknown option "-variable"}}
  207. test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
  208.     catch {.c cget -variable}
  209. } {0}
  210. test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
  211.     list [catch {.c cget -value} msg] $msg
  212. } {1 {unknown option "-value"}}
  213. test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
  214.     catch {.r cget -value}
  215. } {0}
  216. test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
  217.     list [catch {.r cget -onvalue} msg] $msg
  218. } {1 {unknown option "-onvalue"}}
  219. test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
  220.     llength [.c configure]
  221. } {39}
  222. test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
  223.     list [catch {.b configure -gorp} msg] $msg
  224. } {1 {unknown option "-gorp"}}
  225. test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
  226.     list [catch {.b co -bg #ffffff -fg} msg] $msg
  227. } {1 {value for "-fg" missing}}
  228. test button-4.17 {ButtonWidgetCmd procedure, "configure" option} {
  229.     .b configure -fg #123456
  230.     .b configure -bg #654321
  231.     lindex [.b configure -fg] 4
  232. } {#123456}
  233. .c configure -variable value -onvalue 1 -offvalue 0
  234. .r configure -variable value2 -value red
  235. test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
  236.     list [catch {.c deselect foo} msg] $msg
  237. } {1 {wrong # args: should be ".c deselect"}}
  238. test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
  239.     list [catch {.l deselect} msg] $msg
  240. } {1 {bad option "deselect": must be cget or configure}}
  241. test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
  242.     list [catch {.b deselect} msg] $msg
  243. } {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
  244. test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
  245.     set value 1
  246.     .c d
  247.     set value
  248. } {0}
  249. test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
  250.     set value2 green
  251.     .r deselect
  252.     set value2
  253. } {green}
  254. test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
  255.     set value2 red
  256.     .r deselect
  257.     set value2
  258. } {}
  259. test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
  260.     set value 1
  261.     trace variable value w bogusTrace
  262.     set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
  263.     trace vdelete value w bogusTrace
  264.     set result
  265. } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
  266.     while executing
  267. ".c deselect"} 0}
  268. test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} {
  269.     set value2 red
  270.     trace variable value2 w bogusTrace
  271.     set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
  272.     trace vdelete value2 w bogusTrace
  273.     set result
  274. } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
  275.     while executing
  276. ".r deselect"} {}}
  277. test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
  278.     list [catch {.b flash foo} msg] $msg
  279. } {1 {wrong # args: should be ".b flash"}}
  280. test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
  281.     list [catch {.l flash} msg] $msg
  282. } {1 {bad option "flash": must be cget or configure}}
  283. test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
  284.     list [catch {.b flash} msg] $msg
  285. } {0 {}}
  286. test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
  287.     list [catch {.c flash} msg] $msg
  288. } {0 {}}
  289. test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
  290.     list [catch {.r f} msg] $msg
  291. } {0 {}}
  292. test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
  293.     list [catch {.b invoke foo} msg] $msg
  294. } {1 {wrong # args: should be ".b invoke"}}
  295. test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
  296.     list [catch {.l invoke} msg] $msg
  297. } {1 {bad option "invoke": must be cget or configure}}
  298. test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
  299.     .b configure -command {set x invoked}
  300.     set x "not invoked"
  301.     .b invoke
  302.     set x
  303. } {invoked}
  304. test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
  305.     .b configure -command {set x invoked} -state disabled
  306.     set x "not invoked"
  307.     .b invoke
  308.     set x
  309. } {not invoked}
  310. test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
  311.     set value bogus
  312.     .c configure -command {set x invoked} -variable value -onvalue 1 
  313.     -offvalue 0
  314.     set x "not invoked"
  315.     .c invoke
  316.     list $x $value
  317. } {invoked 1}
  318. test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} {
  319.     set value2 green
  320.     .r configure -command {set x invoked} -variable value2 -value red
  321.     set x "not invoked"
  322.     .r i
  323.     list $x $value2
  324. } {invoked red}
  325. test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
  326.     list [catch {.l select} msg] $msg
  327. } {1 {bad option "select": must be cget or configure}}
  328. test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
  329.     list [catch {.b select} msg] $msg
  330. } {1 {bad option "select": must be cget, configure, flash, or invoke}}
  331. test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
  332.     list [catch {.c select foo} msg] $msg
  333. } {1 {wrong # args: should be ".c select"}}
  334. test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
  335.     set value bogus
  336.     .c configure -command {} -variable value -onvalue lovely -offvalue 0
  337.     .c s
  338.     set value
  339. } {lovely}
  340. test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
  341.     set value2 green
  342.     .r configure -command {} -variable value2 -value red
  343.     .r select
  344.     set value2
  345. } {red}
  346. test button-4.42 {ButtonWidgetCmd procedure, "select" option} {
  347.     set value2 yellow
  348.     trace variable value2 w bogusTrace
  349.     set result [list [catch {.r select} msg] $msg $errorInfo $value2]
  350.     trace vdelete value2 w bogusTrace
  351.     set result
  352. } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
  353.     while executing
  354. ".r select"} red}
  355. test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
  356.     list [catch {.l toggle} msg] $msg
  357. } {1 {bad option "toggle": must be cget or configure}}
  358. test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
  359.     list [catch {.b toggle} msg] $msg
  360. } {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
  361. test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
  362.     list [catch {.r toggle} msg] $msg
  363. } {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
  364. test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
  365.     list [catch {.c toggle foo} msg] $msg
  366. } {1 {wrong # args: should be ".c toggle"}}
  367. test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
  368.     set value bogus
  369.     .c configure -command {} -variable value -onvalue sunshine -offvalue rain
  370.     .c toggle
  371.     set result $value
  372.     .c toggle
  373.     lappend result $value
  374.     .c toggle
  375.     lappend result $value
  376. } {sunshine rain sunshine}
  377. test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
  378.     .c configure -onvalue xyz -offvalue abc
  379.     set value xyz
  380.     trace variable value w bogusTrace
  381.     set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
  382.     trace vdelete value w bogusTrace
  383.     set result
  384. } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
  385.     while executing
  386. ".c toggle"} abc}
  387. test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
  388.     .c configure -onvalue xyz -offvalue abc
  389.     set value abc
  390.     trace variable value w bogusTrace
  391.     set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
  392.     trace vdelete value w bogusTrace
  393.     set result
  394. } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
  395.     while executing
  396. ".c toggle"} xyz}
  397. test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
  398.     catch {unset value}; set value(1) 1;
  399.     set result [list [catch {.c toggle} msg] $msg $errorInfo]
  400.     unset value;
  401.     set result
  402. } {1 {can't set "value": variable is array} {can't set "value": variable is array
  403.     while executing
  404. ".c toggle"}}
  406. test button-5.1 {DestroyButton procedure} testImageType {
  407.     image create test image1
  408.     button .b1 -image image1
  409.     button .b2 -fg #ff0000 -text "Button 2"
  410.     button .b3 -state active -text "Button 3"
  411.     button .b4 -disabledforeground #0000ff -state disabled -text "Button 4"
  412.     checkbutton .b5 -variable x -text "Checkbutton 5"
  413.     set x 1
  414.     pack .b1 .b2 .b3 .b4 .b5
  415.     update
  416.     deleteWindows
  417. } {}
  419. test button-6.1 {ConfigureButton - textvariable trace} {
  420.     catch {destroy .b1}
  421.     button .b1 -bd 4 -bg green
  422.     catch {.b1 configure -bd 7 -bg green -fg bogus}
  423.     list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] 
  424.     $msg [.b1 cget -bd] [.b1 cget -bg]
  425. } {1 {unknown color name "bogus"} 4 green}
  426. test button-6.2 {ConfigureButton - textvariable trace} {
  427.     catch {destroy .b1}
  428.     set x From-x
  429.     set y From-y
  430.     button .b1 -textvariable x
  431.     .b1 configure -textvariable y
  432.     set x New
  433.     lindex [.b1 configure -text] 4
  434. } {From-y}
  435. test button-6.2 {ConfigureButton - variable traces} {
  436.     catch {destroy .b1}
  437.     catch {unset x}
  438.     checkbutton .b1 -variable x
  439.     set x 1
  440.     set y 1
  441.     .b1 configure -textvariable y
  442.     set x 0
  443.     .b1 toggle
  444.     set y
  445. } {1}
  446. test button-6.3 {ConfigureButton - image handling} testImageType {
  447.     catch {destroy .b1}
  448.     eval image delete [image names]
  449.     image create test image1
  450.     image create test image2
  451.     button .b1 -image image1
  452.     image delete image1
  453.     .b1 configure -image image2
  454.     image names
  455. } {image2}
  456. test button-6.5 {ConfigureButton - default value for variable} {
  457.     catch {destroy .b1}
  458.     checkbutton .b1
  459.     .b1 cget -variable
  460. } {b1}
  461. test button-6.6 {ConfigureButton - setting selected state from variable} {
  462.     catch {destroy .b1}
  463.     set x 0
  464.     set y Shiny
  465.     checkbutton .b1 -variable x
  466.     .b1 configure -variable y -onvalue Shiny
  467.     .b1 toggle
  468.     set y
  469. } 0
  470. test button-6.7 {ConfigureButton - setting selected state from variable} {
  471.     catch {destroy .b1}
  472.     catch {unset x}
  473.     checkbutton .b1 -variable x -offvalue Bogus
  474.     set x
  475. } Bogus
  476. test button-6.8 {ConfigureButton - setting selected state from variable} {
  477.     catch {destroy .b1}
  478.     catch {unset x}
  479.     radiobutton .b1 -variable x
  480.     set x
  481. } {}
  482. test button-6.9 {ConfigureButton - error in setting variable} {
  483.     catch {destroy .b1}
  484.     catch {unset x}
  485.     trace variable x w bogusTrace
  486.     set result [list [catch {radiobutton .b1 -variable x} msg] $msg]
  487.     trace vdelete x w bogusTrace
  488.     set result
  489. } {1 {can't set "x": trace aborted}}
  490. test button-6.10 {ConfigureButton - bad image name} {
  491.     catch {destroy .b1}
  492.     list [catch {button .b1 -image bogus} msg] $msg
  493. } {1 {image "bogus" doesn't exist}}
  494. test button-6.11 {ConfigureButton - setting variable from current text value} {
  495.     catch {destroy .b1}
  496.     catch {unset x}
  497.     button .b1 -textvariable x -text "Button 1"
  498.     set x
  499. } {Button 1}
  500. test button-6.12 {ConfigureButton - using current value of variable} {
  501.     catch {destroy .b1}
  502.     set x Override
  503.     button .b1 -textvariable x -text "Button 1"
  504.     set x
  505. } {Override}
  506. test button-6.13 {ConfigureButton - variable handling} {
  507.     catch {destroy .b1}
  508.     catch {unset x}
  509.     trace variable x w bogusTrace
  510.     set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] 
  511.     $msg $x]
  512.     trace vdelete x w bogusTrace
  513.     set result
  514. } {1 {can't set "x": trace aborted} foo}
  515. test button-6.14 {ConfigureButton - -width option} {
  516.     catch {destroy .b1}
  517.     button .b1 -text "Button 1"
  518.     list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
  519. } {1 {expected integer but got "1i"} {expected integer but got "1i"
  520.     (processing -width option)
  521.     invoked from within
  522. ".b1 configure -width 1i"}}
  523. test button-6.15 {ConfigureButton - -height option} {
  524.     catch {destroy .b1}
  525.     button .b1 -text "Button 1"
  526.     list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
  527. } {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
  528.     (processing -height option)
  529.     invoked from within
  530. ".b1 configure -height 0.5c"}}
  531. test button-6.16 {ConfigureButton - -width option} {
  532.     catch {destroy .b1}
  533.     button .b1 -bitmap questhead
  534.     list [catch {.b1 configure -width abc} msg] $msg $errorInfo
  535. } {1 {bad screen distance "abc"} {bad screen distance "abc"
  536.     (processing -width option)
  537.     invoked from within
  538. ".b1 configure -width abc"}}
  539. test button-6.17 {ConfigureButton - -height option} testImageType {
  540.     catch {destroy .b1}
  541.     eval image delete [image names]
  542.     image create test image1
  543.     button .b1 -image image1
  544.     list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo
  545. } {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
  546.     (processing -height option)
  547.     invoked from within
  548. ".b1 configure -height 0.5x"}}
  549. test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
  550.     catch {destroy .b1}
  551.     button .b1 -text "Sample text" -width 10 -height 2
  552.     pack .b1
  553.     set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
  554.     .b1 configure -bitmap questhead
  555.     lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
  556. } {102 46 20 12}
  557. test button-6.19 {ConfigureButton - computing geometry} {
  558.     catch {destroy .b1}
  559.     button .b1 -text "Button 1"
  560.     set old [winfo reqwidth .b1]
  561.     .b1 configure -text "Much longer text"
  562.     set new [winfo reqwidth .b1]
  563.     expr $old == $new
  564. } {0}
  566. test button-7.1 {ButtonEventProc procedure} {
  567.     catch {destroy .b1}
  568.     button .b1 -text "Test Button" -command {
  569. destroy .b1
  570. set x [list [winfo exists .b1] [info commands .b1]]
  571.     }
  572.     .b1 invoke
  573.     set x
  574. } {0 {}}
  575. test button-7.2 {ButtonEventProc procedure} {
  576.     deleteWindows
  577.     button .b1 -bg #543210
  578.     rename .b1 .b2
  579.     set x {}
  580.     lappend x [winfo children .]
  581.     lappend x [.b2 cget -bg]
  582.     destroy .b1
  583.     lappend x [info command .b*] [winfo children .]
  584. } {.b1 #543210 {} {}}
  586. test button-8.1 {ButtonCmdDeletedProc procedure} {
  587.     deleteWindows
  588.     button .b1
  589.     rename .b1 {}
  590.     list [info command .b*] [winfo children .]
  591. } {{} {}}
  593. test button-9.1 {TkInvokeButton procedure} {
  594.     catch {destroy .b1}
  595.     set x 0
  596.     checkbutton .b1 -variable x
  597.     set result $x
  598.     .b1 invoke
  599.     lappend result $x
  600.     .b1 invoke
  601.     lappend result $x
  602. } {0 1 0}
  603. test button-9.2 {TkInvokeButton procedure} {
  604.     catch {destroy .b1}
  605.     set x 0
  606.     checkbutton .b1 -variable x
  607.     trace variable x w bogusTrace
  608.     set result [list [catch {.b1 invoke} msg] $msg $x]
  609.     trace vdelete x w bogusTrace
  610.     set result
  611. } {1 {can't set "x": trace aborted} 1}
  612. test button-9.3 {TkInvokeButton procedure} {
  613.     catch {destroy .b1}
  614.     set x 1
  615.     checkbutton .b1 -variable x
  616.     trace variable x w bogusTrace
  617.     set result [list [catch {.b1 invoke} msg] $msg $x]
  618.     trace vdelete x w bogusTrace
  619.     set result
  620. } {1 {can't set "x": trace aborted} 0}
  621. test button-9.4 {TkInvokeButton procedure} {
  622.     catch {destroy .b1}
  623.     set x 0
  624.     radiobutton .b1 -variable x -value red
  625.     set result $x
  626.     .b1 invoke
  627.     lappend result $x
  628.     .b1 invoke
  629.     lappend result $x
  630. } {0 red red}
  631. test button-9.5 {TkInvokeButton procedure} {
  632.     catch {destroy .b1}
  633.     radiobutton .b1 -variable x -value red
  634.     set x green
  635.     trace variable x w bogusTrace
  636.     set result [list [catch {.b1 invoke} msg] $msg $errorInfo $x]
  637.     trace vdelete x w bogusTrace
  638.     set result
  639. } {1 {can't set "x": trace aborted} {can't set "x": trace aborted
  640.     while executing
  641. ".b1 invoke"} red}
  642. test button-9.6 {TkInvokeButton procedure} {
  643.     deleteWindows
  644.     set result untouched
  645.     button .b1 -command {set result invoked}
  646.     list [catch {.b1 invoke} msg] $msg $result
  647. } {0 invoked invoked}
  648. test button-9.7 {TkInvokeButton procedure} {
  649.     deleteWindows
  650.     set result untouched
  651.     set x 0
  652.     checkbutton .b1 -variable x -command {set result "invoked $x"}
  653.     list [catch {.b1 invoke} msg] $msg $result
  654. } {0 {invoked 1} {invoked 1}}
  655. test button-9.8 {TkInvokeButton procedure} {
  656.     deleteWindows
  657.     set result untouched
  658.     set x 0
  659.     radiobutton .b1 -variable x -value red -command {set result "invoked $x"}
  660.     list [catch {.b1 invoke} msg] $msg $result
  661. } {0 {invoked red} {invoked red}}
  663. test button-10.1 {ButtonVarProc procedure} {
  664.     deleteWindows
  665.     set x 1
  666.     checkbutton .b1 -variable x
  667.     unset x
  668.     set result [info exists x]
  669.     .b1 toggle
  670.     lappend result $x
  671.     set x 0
  672.     .b1 toggle
  673.     lappend result $x
  674. } {0 1 1}
  675. test button-10.2 {ButtonVarProc procedure} {
  676.     deleteWindows
  677.     set x 0
  678.     checkbutton .b1 -variable x
  679.     set x 44
  680.     .b1 toggle
  681.     set x
  682. } {1}
  683. test button-10.3 {ButtonVarProc procedure} {
  684.     deleteWindows
  685.     set x 1
  686.     checkbutton .b1 -variable x
  687.     set x 44
  688.     .b1 toggle
  689.     set x
  690. } {1}
  691. test button-10.4 {ButtonVarProc procedure} {
  692.     deleteWindows
  693.     set x 0
  694.     checkbutton .b1 -variable x
  695.     set x 1
  696.     .b1 toggle
  697.     set x
  698. } {0}
  699. test button-10.5 {ButtonVarProc procedure} {
  700.     deleteWindows
  701.     set x 1
  702.     checkbutton .b1 -variable x
  703.     set x 1
  704.     .b1 toggle
  705.     set x
  706. } {0}
  707. test button-10.6 {ButtonVarProc procedure} {
  708.     deleteWindows
  709.     set x 0
  710.     checkbutton .b1 -variable x
  711.     set x 0
  712.     .b1 toggle
  713.     set x
  714. } {1}
  715. test button-10.7 {ButtonVarProc procedure} {
  716.     deleteWindows
  717.     set x 1
  718.     checkbutton .b1 -variable x
  719.     set x 0
  720.     .b1 toggle
  721.     set x
  722. } {1}
  723. test button-10.8 {ButtonVarProc procedure, can't read variable} {
  724.     # This test does nothing but produce a core dump if there's a prbblem.
  725.     deleteWindows
  726.     catch {unset a}
  727.     checkbutton .b1 -variable a
  728.     unset a
  729.     set a(32) 0
  730.     unset a
  731. } {}
  733. test button-11.1 {ButtonTextVarProc procedure} {
  734.     deleteWindows
  735.     set x Label
  736.     button .b1 -textvariable x
  737.     unset x
  738.     set result [list $x [lindex [.b1 configure -text] 4]]
  739.     set x New
  740.     lappend result [lindex [.b1 configure -text] 4]
  741. } {Label Label New}
  742. test button-11.2 {ButtonTextVarProc procedure} {
  743.     deleteWindows
  744.     # Windows buttons have a default min width, so we have to
  745.     # set this to be longer to force the wider button.
  746.     set x ExtraLongLabel
  747.     button .b1 -textvariable x
  748.     set old [winfo reqwidth .b1]
  749.     set x New
  750.     set new [winfo reqwidth .b1]
  751.     list [lindex [.b1 configure -text] 4] [expr $old == $new]
  752. } {New 0}
  754. test button-12.1 {ButtonImageProc procedure} testImageType {
  755.     deleteWindows
  756.     eval image delete [image names]
  757.     image create test image1
  758.     label .b1 -image image1 -padx 0 -pady 0 -bd 0
  759.     pack .b1
  760.     set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
  761.     image1 changed 0 0 0 0 80 100
  762.     lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
  763. } {30 15 80 100}
  765. deleteWindows
  766. set l [interp hidden]
  768. test button-13.1 {button widget vs hidden commands} {
  769.     catch {destroy .b}
  770.     button .b -text hello
  771.     interp hide {} .b
  772.     destroy .b
  773.     list [winfo children .] [interp hidden]
  774. } [list {} $l]
  776. deleteWindows
  778. test button-14.1 {size behaviouor} {
  779.     set res {}
  780.     foreach class {label button radiobutton checkbutton} {
  781. eval destroy [winfo children .]
  783. $class .a -text Hej 
  784. $class .b -text Hej -width 10 -height 1
  785. $class .c -text "" -width 10 -height 1
  787. for {set t 0} {$t < 2} {incr t} {
  788.     set res2 {}
  789.     # With -width, width should not be affected by text change
  790.     lappend res2 [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}]
  791.     # With -height, height should not be affected by text change
  792.     lappend res2 [expr {[winfo reqheight .b] == [winfo reqheight .c]}]
  793.     # A one line text should be as high as -height 1
  794.     lappend res2 [expr {[winfo reqheight .a] == [winfo reqheight .b]}]
  795.     lappend res $res2
  796.     
  797.     # Do the second round with another font
  798.     .a configure -font "Arial 20"
  799.     .b configure -font "Arial 20"
  800.     .c configure -font "Arial 20"
  801. }
  802.     }
  803.     set res
  804. } {{1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1}}
  806. deleteWindows
  808. option clear
  810. # cleanup
  811. ::tcltest::cleanupTests
  812. return