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

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

通讯编程

开发平台：

Visual C++

scale.test：源码内容
  1. # This file is a Tcl script to test out the "scale" command
  2. # of Tk.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: scale.test,v 1.12.2.1 2003/08/13 10:59:33 patthoyts Exp $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. # Create entries in the option database to be sure that geometry options
  19. # like border width have predictable values.
  21. option add *Scale.borderWidth 2
  22. option add *Scale.highlightThickness 2
  23. option add *Scale.font {Helvetica -12 bold}
  25. scale .s -from 100 -to 300
  26. pack .s
  27. update
  28. set i 1
  29. foreach test {
  30.     {-activebackground #ff0000 #ff0000 non-existent
  31.     {unknown color name "non-existent"}}
  32.     {-background #ff0000 #ff0000 non-existent
  33.     {unknown color name "non-existent"}}
  34.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  35.     {-bigincrement 12.5 12.5 badValue
  36.     {expected floating-point number but got "badValue"}}
  37.     {-bg #ff0000 #ff0000 non-existent
  38.     {unknown color name "non-existent"}}
  39.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  40.     {-command "set x" {set x} {} {}}
  41.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  42.     {-digits 5 5 badValue {expected integer but got "badValue"}}
  43.     {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
  44.     {-font fixed fixed {} {font "" doesn't exist}}
  45.     {-foreground green green badValue {unknown color name "badValue"}}
  46.     {-from -15.0 -15.0 badValue
  47.     {expected floating-point number but got "badValue"}}
  48.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  49.     {-highlightcolor #123456 #123456 non-existent
  50.     {unknown color name "non-existent"}}
  51.     {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
  52.     {-label "Some text" {Some text} {} {}}
  53.     {-length 130 130 badValue {bad screen distance "badValue"}}
  54.     {-orient horizontal horizontal badValue
  55.     {bad orient "badValue": must be horizontal or vertical}}
  56.     {-orient horizontal horizontal {} {}}
  57.     {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  58.     {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
  59.     {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
  60.     {-resolution 2.0 2.0 badValue
  61.     {expected floating-point number but got "badValue"}}
  62.     {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
  63.     {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
  64.     {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  65.     {-state d disabled badValue
  66.     {bad state "badValue": must be active, disabled, or normal}}
  67.     {-state n normal {} {}}
  68.     {-takefocus "any string" "any string" {} {}}
  69.     {-tickinterval 4.3 4.0 badValue
  70.     {expected floating-point number but got "badValue"}}
  71.     {-to 14.9 15.0 badValue
  72.     {expected floating-point number but got "badValue"}}
  73.     {-troughcolor #ff0000 #ff0000 non-existent
  74.     {unknown color name "non-existent"}}
  75.     {-variable x x {} {}}
  76.     {-width 32 32 badValue {bad screen distance "badValue"}}
  77. } {
  78.     set name [lindex $test 0]
  79.     test scale-1.$i {configuration options} {
  80. .s configure $name [lindex $test 1]
  81. lindex [.s configure $name] 4
  82.     } [lindex $test 2]
  83.     incr i
  84.     if {[lindex $test 3] != ""} {
  85. test scale-1.$i {configuration options} {
  86.     list [catch {.s configure $name [lindex $test 3]} msg] $msg
  87. } [list 1 [lindex $test 4]]
  88.     }
  89.     .s configure $name [lindex [.s configure $name] 3]
  90.     incr i
  91. }
  92. destroy .s
  94. test scale-2.1 {Tk_ScaleCmd procedure} {
  95.     list [catch {scale} msg] $msg
  96. } {1 {wrong # args: should be "scale pathName ?options?"}}
  97. test scale-2.2 {Tk_ScaleCmd procedure} {
  98.     list [catch {scale foo} msg] $msg [winfo child .]
  99. } {1 {bad window path name "foo"} {}}
  100. test scale-2.3 {Tk_ScaleCmd procedure} {
  101.     list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
  102. } {1 {unknown option "-gorp"} {}}
  104. scale .s -from 100 -to 200
  105. pack .s
  106. update idletasks
  107. test scale-3.1 {ScaleWidgetCmd procedure} {
  108.     list [catch {.s} msg] $msg
  109. } {1 {wrong # args: should be ".s option ?arg arg ...?"}}
  110. test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
  111.     list [catch {.s cget} msg] $msg
  112. } {1 {wrong # args: should be ".s cget option"}}
  113. test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
  114.     list [catch {.s cget a b} msg] $msg
  115. } {1 {wrong # args: should be ".s cget option"}}
  116. test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
  117.     list [catch {.s cget -gorp} msg] $msg
  118. } {1 {unknown option "-gorp"}}
  119. test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
  120.     .s cget -highlightthickness
  121. } {2}
  122. test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
  123.     list [llength [.s configure]] [lindex [.s configure] 6]
  124. } {33 {-command command Command {} {}}}
  125. test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
  126.     list [catch {.s configure -foo} msg] $msg
  127. } {1 {unknown option "-foo"}}
  128. test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
  129.     list [catch {.s configure -borderwidth 2 -bg} msg] $msg
  130. } {1 {value for "-bg" missing}}
  131. test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
  132.     list [catch {.s coords a b} msg] $msg
  133. } {1 {wrong # args: should be ".s coords ?value?"}}
  134. test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
  135.     list [catch {.s coords bad} msg] $msg
  136. } {1 {expected floating-point number but got "bad"}}
  137. test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
  138.     .s set 120
  139.     .s coords
  140. } {38 34}
  141. test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
  142.     .s configure -orient horizontal
  143.     update
  144.     .s set 120
  145.     .s coords
  146. } {34 31}
  147. .s configure -orient vertical
  148. update
  149. test scale-3.13 {ScaleWidgetCmd procedure, get option} {
  150.     list [catch {.s get a} msg] $msg
  151. } {1 {wrong # args: should be ".s get ?x y?"}}
  152. test scale-3.14 {ScaleWidgetCmd procedure, get option} {
  153.     list [catch {.s get a b c} msg] $msg
  154. } {1 {wrong # args: should be ".s get ?x y?"}}
  155. test scale-3.15 {ScaleWidgetCmd procedure, get option} {
  156.     list [catch {.s get a 11} msg] $msg
  157. } {1 {expected integer but got "a"}}
  158. test scale-3.16 {ScaleWidgetCmd procedure, get option} {
  159.     list [catch {.s get 12 b} msg] $msg
  160. } {1 {expected integer but got "b"}}
  161. test scale-3.17 {ScaleWidgetCmd procedure, get option} {
  162.     .s set 133
  163.     .s get
  164. } 133
  165. test scale-3.18 {ScaleWidgetCmd procedure, get option} {
  166.     .s configure -resolution 0.5
  167.     .s set 150
  168.     .s get 37 34
  169. } 119.5
  170. .s configure -resolution 1
  171. test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
  172.     list [catch {.s identify} msg] $msg
  173. } {1 {wrong # args: should be ".s identify x y"}}
  174. test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
  175.     list [catch {.s identify 1 2 3} msg] $msg
  176. } {1 {wrong # args: should be ".s identify x y"}}
  177. test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
  178.     list [catch {.s identify boo 16} msg] $msg
  179. } {1 {expected integer but got "boo"}}
  180. test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
  181.     list [catch {.s identify 17 bad} msg] $msg
  182. } {1 {expected integer but got "bad"}}
  183. test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
  184.     .s set 120
  185.     list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
  186. } {trough1 slider trough2 {}}
  187. test scale-3.24 {ScaleWidgetCmd procedure, set option} {
  188.     list [catch {.s set} msg] $msg
  189. } {1 {wrong # args: should be ".s set value"}}
  190. test scale-3.25 {ScaleWidgetCmd procedure, set option} {
  191.     list [catch {.s set a b} msg] $msg
  192. } {1 {wrong # args: should be ".s set value"}}
  193. test scale-3.26 {ScaleWidgetCmd procedure, set option} {
  194.     list [catch {.s set bad} msg] $msg
  195. } {1 {expected floating-point number but got "bad"}}
  196. test scale-3.27 {ScaleWidgetCmd procedure, set option} {
  197.     .s set 142
  198. } {}
  199. test scale-3.28 {ScaleWidgetCmd procedure, set option} {
  200.     .s set 118
  201.     .s configure -state disabled
  202.     .s set 181
  203.     .s configure -state normal
  204.     .s get
  205. } {118}
  206. test scale-3.29 {ScaleWidgetCmd procedure} {
  207.     list [catch {.s dumb} msg] $msg
  208. } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
  209. test scale-3.30 {ScaleWidgetCmd procedure} {
  210.     list [catch {.s c} msg] $msg
  211. } {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
  212. test scale-3.31 {ScaleWidgetCmd procedure} {
  213.     list [catch {.s co} msg] $msg
  214. } {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
  215. test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
  216.     proc kill args {
  217. destroy .s
  218.     }
  219.     catch {destroy .s}
  220.     scale .s -variable x -from 0 -to 100 -orient horizontal
  221.     pack .s
  222.     update
  223.     .s configure -command kill
  224.     .s set 55
  225. } {}
  227. test scale-4.1 {DestroyScale procedure} {
  228.     catch {destroy .s}
  229.     set x 50
  230.     scale .s -variable x -from 0 -to 100 -orient horizontal
  231.     pack .s
  232.     update
  233.     destroy .s
  234.     list [catch {set x foo} msg] $msg $x
  235. } {0 foo foo}
  237. test scale-5.1 {ConfigureScale procedure} {
  238.     catch {destroy .s}
  239.     set x 66
  240.     set y 77
  241.     scale .s -variable x -from 0 -to 100
  242.     pack .s
  243.     update
  244.     .s configure -variable y
  245.     list [catch {set x foo} msg] $msg $x [.s get]
  246. } {0 foo foo 77}
  247. test scale-5.2 {ConfigureScale procedure} {
  248.     catch {destroy .s}
  249.     scale .s -from 0 -to 100
  250.     list [catch {.s configure -foo bar} msg] $msg
  251. } {1 {unknown option "-foo"}}
  252. test scale-5.3 {ConfigureScale procedure} {
  253.     catch {destroy .s}
  254.     catch {unset x}
  255.     scale .s -from 0 -to 100 -variable x
  256.     set result $x
  257.     lappend result [.s get]
  258.     set x 92
  259.     lappend result [.s get]
  260.     .s set 3
  261.     lappend result $x
  262.     unset x
  263.     lappend result [catch {set x} msg] $msg
  264. } {0 0 92 3 0 3}
  265. test scale-5.4 {ConfigureScale procedure} {
  266.     catch {destroy .s}
  267.     scale .s -from 0 -to 100
  268.     list [catch {.s configure -orient dumb} msg] $msg
  269. } {1 {bad orient "dumb": must be horizontal or vertical}}
  270. test scale-5.5 {ConfigureScale procedure} {
  271.     catch {destroy .s}
  272.     scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
  273.     list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] 
  274.     [format %.1f [.s cget -tickinterval]]
  275. } {1.1 1.9 0.8}
  276. test scale-5.6 {ConfigureScale procedure} {
  277.     catch {destroy .s}
  278.     scale .s -from 1 -to 10 -tickinterval -2
  279.     pack .s
  280.     set result [lindex [.s configure -tickinterval] 4]
  281.     .s configure -from 10 -to 1 -tickinterval 2
  282.     lappend result [lindex [.s configure -tickinterval] 4]
  283. } {2.0 -2.0}
  284. test scale-5.7 {ConfigureScale procedure} {
  285.     catch {destroy .s}
  286.     list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
  287. } {1 {bad state "bogus": must be active, disabled, or normal}}
  289. catch {destroy .s}
  290. scale .s -orient horizontal -length 200
  291. pack .s
  292. test scale-6.1 {ComputeFormat procedure} {
  293.     .s configure -from 10 -to 100 -resolution 10
  294.     .s set 49.3
  295.     .s get
  296. } {50}
  297. test scale-6.2 {ComputeFormat procedure} {
  298.     .s configure -from 100 -to 1000 -resolution 100
  299.     .s set 493
  300.     .s get
  301. } {500}
  302. test scale-6.3 {ComputeFormat procedure} {
  303.     .s configure -from 1000 -to 10000 -resolution 1000
  304.     .s set 4930
  305.     .s get
  306. } {5000}
  307. test scale-6.4 {ComputeFormat procedure} {
  308.     .s configure -from 10000 -to 100000 -resolution 10000
  309.     .s set 49000
  310.     .s get
  311. } {50000}
  312. test scale-6.5 {ComputeFormat procedure} {
  313.     .s configure -from 100000 -to 1000000 -resolution 100000
  314.     .s set 493000
  315.     .s get
  316. } {500000}
  317. test scale-6.6 {ComputeFormat procedure} {nonPortable} {
  318.     # This test is non-portable because some platforms format the
  319.     # result as 5e+06.
  321.     .s configure -from 1000000 -to 10000000 -resolution 1000000
  322.     .s set 4930000
  323.     .s get
  324. } {5000000}
  325. test scale-6.7 {ComputeFormat procedure} {
  326.     .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
  327.     .s set 4930000000
  328.     expr {[.s get] == 5.0e+09}
  329. } 1
  330. test scale-6.8 {ComputeFormat procedure} {
  331.     .s configure -from .1 -to 1 -resolution .1
  332.     .s set .6
  333.     .s get
  334. } {0.6}
  335. test scale-6.9 {ComputeFormat procedure} {
  336.     .s configure -from .01 -to .1 -resolution .01
  337.     .s set .06
  338.     .s get
  339. } {0.06}
  340. test scale-6.10 {ComputeFormat procedure} {
  341.     .s configure -from .001 -to .01 -resolution .001
  342.     .s set .006
  343.     .s get
  344. } {0.006}
  345. test scale-6.11 {ComputeFormat procedure} {
  346.     .s configure -from .0001 -to .001 -resolution .0001
  347.     .s set .0006
  348.     .s get
  349. } {0.0006}
  350. test scale-6.12 {ComputeFormat procedure} {
  351.     .s configure -from .00001 -to .0001 -resolution .00001
  352.     .s set .00006
  353.     .s get
  354. } {0.00006}
  355. test scale-6.13 {ComputeFormat procedure} {
  356.     .s configure -from .000001 -to .00001 -resolution .000001
  357.     .s set .000006
  358.     expr {[.s get] == 6.0e-06}
  359. } {1}
  360. test scale-6.14 {ComputeFormat procedure} {
  361.     .s configure -to .00001 -from .0001 -resolution .00001
  362.     .s set .00006
  363.     .s get
  364. } {0.00006}
  365. test scale-6.15 {ComputeFormat procedure} {
  366.     .s configure -to .000001 -from .00001 -resolution .000001
  367.     .s set .000006
  368.     expr {[.s get] == 6.0e-06}
  369. } {1}
  370. test scale-6.16 {ComputeFormat procedure} {
  371.     .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
  372.     .s set .00006
  373.     expr {[.s get] == 6e-05}
  374. } {1}
  375. test scale-6.17 {ComputeFormat procedure} {
  376.     .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
  377.     .s set 49300000
  378.     .s get
  379. } {50000000}
  380. test scale-6.18 {ComputeFormat procedure} {
  381.     .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
  382.     .s set .111111111
  383.     .s get
  384. } {0.11}
  385. test scale-6.19 {ComputeFormat procedure} {
  386.     .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
  387.     .s set 1001.23456789
  388.     .s get
  389. } {1001.23}
  390. test scale-6.20 {ComputeFormat procedure} {
  391.     .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
  392.     .s set 1001.23456789
  393.     .s get
  394. } {1001.235}
  396. test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
  397.     catch {destroy .s}
  398.     scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
  399.     pack .s
  400.     update
  401.     list [winfo reqwidth .s] [winfo reqheight .s]
  402. } {88 458}
  403. test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
  404.     catch {destroy .s}
  405.     scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
  406.     pack .s
  407.     update
  408.     list [winfo reqwidth .s] [winfo reqheight .s]
  409. } {168 108}
  410. test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
  411.     catch {destroy .s}
  412.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 
  413.     -sliderlength 10
  414.     pack .s
  415.     update
  416.     list [winfo reqwidth .s] [winfo reqheight .s]
  417. } {22 108}
  418. test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
  419.     catch {destroy .s}
  420.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 
  421.     -relief sunken
  422.     pack .s
  423.     update
  424.     list [winfo reqwidth .s] [winfo reqheight .s]
  425. } {39 114}
  426. test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
  427.     catch {destroy .s}
  428.     scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
  429.     pack .s
  430.     update
  431.     list [winfo reqwidth .s] [winfo reqheight .s]
  432. } {458 61}
  433. test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
  434.     catch {destroy .s}
  435.     scale .s -from 0 -to 1000 -label "Long string" -orient horizontal 
  436.     -tick 500
  437.     pack .s
  438.     update
  439.     list [winfo reqwidth .s] [winfo reqheight .s]
  440. } {108 79}
  441. test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
  442.     catch {destroy .s}
  443.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
  444.     pack .s
  445.     update
  446.     list [winfo reqwidth .s] [winfo reqheight .s]
  447. } {108 27}
  448. test scale-7.8 {ComputeScaleGeometry procedure} {
  449.     catch {destroy .s}
  450.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 
  451.     -relief raised -highlightthickness 2
  452.     pack .s
  453.     update
  454.     list [winfo reqwidth .s] [winfo reqheight .s]
  455. } {114 39}
  457. test scale-8.1 {ScaleElement procedure} {fonts} {
  458.     catch {destroy .s}
  459.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  460.     pack .s
  461.     .s set 30
  462.     update
  463.     list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] 
  464.     [.s identify 71 52]
  465. } {{} trough1 trough1 {}}
  466. test scale-8.2 {ScaleElement procedure} {fonts} {
  467.     catch {destroy .s}
  468.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  469.     pack .s
  470.     .s set 30
  471.     update
  472.     list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] 
  473.     [.s identify 60 303]
  474. } {{} trough1 trough2 {}}
  475. test scale-8.3 {ScaleElement procedure} {fonts} {
  476.     catch {destroy .s}
  477.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  478.     pack .s
  479.     .s set 30
  480.     update
  481.     list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] 
  482.     [.s identify 60 114] 
  483. } {trough1 slider slider trough2}
  484. test scale-8.4 {ScaleElement procedure} {
  485.     catch {destroy .s}
  486.     scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 
  487.     -highlightthickness 1 -length 300 -showvalue 0
  488.     pack .s
  489.     .s set 30
  490.     update
  491.     list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] 
  492.     [.s identify 23 40] 
  493. } {{} trough1 trough1 {}}
  494. test scale-8.5 {ScaleElement procedure} {fonts} {
  495.     catch {destroy .s}
  496.     scale .s -from 0 -to 100 -orient horizontal -bd 1 
  497.     -highlightthickness 2 -tick 20 -sliderlength 20 
  498.     -length 200 -label Test
  499.     pack .s
  500.     .s set 30
  501.     update
  502.     list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] 
  503.     [.s identify 150 54]
  504. } {{} trough2 trough2 {}}
  505. test scale-8.6 {ScaleElement procedure} {fonts} {
  506.     catch {destroy .s}
  507.     scale .s -from 0 -to 100 -orient horizontal -bd 2 
  508.     -highlightthickness 1 -tick 20 -length 200
  509.     pack .s
  510.     .s set 30
  511.     update
  512.     list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] 
  513.     [.s identify 150 40]
  514. } {{} trough2 trough2 {}}
  515. test scale-8.7 {ScaleElement procedure} {
  516.     catch {destroy .s}
  517.     scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 
  518.     -length 200 -width 10 -showvalue 0
  519.     pack .s
  520.     .s set 30
  521.     update
  522.     list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] 
  523.     [.s identify 30 24]
  524. } {{} trough1 trough1 {}}
  525. test scale-8.8 {ScaleElement procedure} {
  526.     catch {destroy .s}
  527.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 
  528.     -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  529.     pack .s
  530.     .s set 30
  531.     update
  532.     list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] 
  533.     [.s identify 203 28]
  534. } {{} trough1 trough2 {}}
  535. test scale-8.9 {ScaleElement procedure} {
  536.     catch {destroy .s}
  537.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 
  538.     -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  539.     pack .s
  540.     .s set 80
  541.     update
  542.     list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] 
  543.     [.s identify 166 28]
  544. } {trough1 slider slider trough2}
  546. catch {destroy .s}
  547. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
  548. pack .s
  549. update
  550. test scale-9.1 {PixelToValue procedure} {
  551.     .s get 46 0
  552. } 0
  553. test scale-9.2 {PixelToValue procedure} {
  554.     .s get -10 9
  555. } 0
  556. test scale-9.3 {PixelToValue procedure} {
  557.     .s get -10 12
  558. } 1
  559. test scale-9.4 {PixelToValue procedure} {
  560.     .s get -10 46
  561. } 35
  562. test scale-9.5 {PixelToValue procedure} {
  563.     .s get -10 110
  564. } 99
  565. test scale-9.6 {PixelToValue procedure} {
  566.     .s get -10 111
  567. } 100
  568. test scale-9.7 {PixelToValue procedure} {
  569.     .s get -10 112
  570. } 100
  571. test scale-9.8 {PixelToValue procedure} {
  572.     .s get -10 154
  573. } 100
  574. .s configure -orient horizontal
  575. update
  576. test scale-9.9 {PixelToValue procedure} {
  577.     .s get 76 152
  578. } 65
  580. test scale-10.1 {ValueToPixel procedure} {fonts} {
  581.     catch {destroy .s}
  582.     scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 
  583.     -orient horizontal -label Test -tick 20
  584.     pack .s
  585.     update
  586.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  587. } {{16 47} {56 47} {116 47}}
  588. test scale-10.2 {ValueToPixel procedure} {fonts} {
  589.     catch {destroy .s}
  590.     scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 
  591.     -orient vertical -label Test -tick 20
  592.     pack .s
  593.     update
  594.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  595. } {{62 114} {62 74} {62 14}}
  597. test scale-11.1 {ScaleEventProc procedure} {
  598.     proc killScale value {
  599. global x
  600. if {$value > 30} {
  601.     destroy .s1
  602.     lappend x [winfo exists .s1] [info commands .s1]
  603. }
  604.     }
  605.     catch {destroy .s1}
  606.     set x initial
  607.     scale .s1 -from 0 -to 100 -command killScale
  608.     .s1 set 20
  609.     pack .s1
  610.     update idletasks
  611.     lappend x [winfo exists .s1]
  612.     .s1 set 40
  613.     update idletasks
  614.     rename killScale {}
  615.     set x
  616. } {initial 1 0 {}}
  617. test scale-11.2 {ScaleEventProc procedure} {
  618.     deleteWindows
  619.     scale .s1 -bg #543210
  620.     rename .s1 .s2
  621.     set x {}
  622.     lappend x [winfo children .]
  623.     lappend x [.s2 cget -bg]
  624.     destroy .s1
  625.     lappend x [info command .s*] [winfo children .]
  626. } {.s1 #543210 {} {}}
  628. test scale-12.1 {ScaleCmdDeletedProc procedure} {
  629.     deleteWindows
  630.     scale .s1
  631.     rename .s1 {}
  632.     list [info command .s*] [winfo children .]
  633. } {{} {}}
  635. catch {destroy .s}
  636. scale .s -from 0 -to 100 -command {set x} -variable y
  637. pack .s
  638. update
  639. proc varTrace args {
  640.     global traceInfo
  641.     set traceInfo $args
  642. }
  643. test scale-13.1 {SetScaleValue procedure} {
  644.     set x xyzzy
  645.     .s set 44
  646.     set result [list $x $y]
  647.     update
  648.     lappend result $x $y
  649. } {xyzzy 44 44 44}
  650. test scale-13.2 {SetScaleValue procedure} {
  651.     .s set -3
  652.     .s get
  653. } 0
  654. test scale-13.3 {SetScaleValue procedure} {
  655.     .s set 105
  656.     .s get
  657. } 100
  658. .s configure -from 100 -to 0
  659. test scale-13.4 {SetScaleValue procedure} {
  660.     .s set -3
  661.     .s get
  662. } 0
  663. test scale-13.5 {SetScaleValue procedure} {
  664.     .s set 105
  665.     .s get
  666. } 100
  667. test scale-13.6 {SetScaleValue procedure} {
  668.     .s set 50
  669.     update
  670.     trace variable y w varTrace
  671.     set traceInfo empty
  672.     set x untouched
  673.     .s set 50
  674.     update
  675.     list $x $traceInfo
  676. } {untouched empty}
  678. catch {destroy .s}
  679. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
  680. pack .s
  681. update
  682. .s configure -resolution 4.0
  683. update
  684. test scale-14.1 {RoundToResolution procedure} {
  685.     .s get 84 152
  686. } 72
  687. test scale-14.2 {RoundToResolution procedure} {
  688.     .s get 86 152
  689. } 76
  690. .s configure -from 100 -to 0
  691. update
  692. test scale-14.3 {RoundToResolution procedure} {
  693.     .s get 84 152
  694. } 28
  695. test scale-14.4 {RoundToResolution procedure} {
  696.     .s get 86 152
  697. } 24
  698. .s configure -from -100 -to 0
  699. update
  700. test scale-14.5 {RoundToResolution procedure} {
  701.     .s get 84 152
  702. } -28
  703. test scale-14.6 {RoundToResolution procedure} {
  704.     .s get 86 152
  705. } -24
  706. .s configure -from 0 -to -100
  707. update
  708. test scale-14.7 {RoundToResolution procedure} {
  709.     .s get 84 152
  710. } -72
  711. test scale-14.8 {RoundToResolution procedure} {
  712.     .s get 86 152
  713. } -76
  714. .s configure -from 0 -to 2.25 -resolution 0
  715. update
  716. test scale-14.9 {RoundToResolution procedure} {
  717.     .s get 84 152
  718. } 1.64
  719. test scale-14.10 {RoundToResolution procedure} {
  720.     .s get 86 152
  721. } 1.69
  722. .s configure -from 0 -to 225 -resolution 0  -digits 5
  723. update
  724. test scale-14.11 {RoundToResolution procedure} {
  725.     .s get 84 152
  726. } 164.25
  727. test scale-14.12 {RoundToResolution procedure} {
  728.     .s get 86 152
  729. } 168.75
  731. test scale-15.1 {ScaleVarProc procedure} {
  732.     catch {destroy .s}
  733.     set y -130
  734.     scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
  735.     pack .s
  736.     set y
  737. } -130
  738. test scale-15.2 {ScaleVarProc procedure} {
  739.     catch {destroy .s}
  740.     set y -130
  741.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  742.     pack .s
  743.     set y -87
  744.     .s get
  745. } -87
  746. test scale-15.3 {ScaleVarProc procedure} {
  747.     catch {destroy .s}
  748.     set y -130
  749.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  750.     pack .s
  751.     list [catch {set y 40q} msg] $msg [.s get]
  752. } {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
  753. test scale-15.4 {ScaleVarProc procedure} {
  754.     catch {destroy .s}
  755.     set y 1
  756.     scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
  757.     pack .s
  758.     list [catch {set y x} msg] $msg [.s get]
  759. } {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
  760. test scale-15.5 {ScaleVarProc procedure, variable deleted} {
  761.     catch {destroy .s}
  762.     set y 6
  763.     scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 
  764.     -command "set x"
  765.     pack .s
  766.     update
  767.     set x untouched
  768.     unset y
  769.     update
  770.     list [catch {set y} msg] $msg [.s get] $x
  771. } {0 6 6 untouched}
  772. test scale-15.6 {ScaleVarProc procedure, don't call -command} {
  773.     catch {destroy .s}
  774.     set y 6
  775.     scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 
  776.     -command "set x"
  777.     pack .s
  778.     update
  779.     set x untouched
  780.     set y 60
  781.     update
  782.     list $x [.s get]
  783. } {untouched 60}
  785. set l [interp hidden]
  786. deleteWindows
  788. test scale-16.1 {scale widget vs hidden commands} {
  789.     catch {destroy .s}
  790.     scale .s
  791.     interp hide {} .s
  792.     destroy .s
  793.     list [winfo children .] [interp hidden]
  794. } [list {} $l]
  796. test scale-17.1 {bug fix 1786} {
  797.     # Perhaps x is set to {}, depending on what other tests have run.
  798.     # If x is unset, or set to something not convertable to a double,
  799.     # then the scale try to initialize its value with the contents
  800.     # of uninitialized memory.  Sometimes that causes an FPE.
  802.     set x {}
  803.     scale .s -from 100 -to 300
  804.     pack .s
  805.     update
  806.     .s configure -variable x   ;# CRASH! -> Floating point exception
  808.     # Bug 4833 changed the result to realize that x should pick up
  809.     # a value from the scale.  In an FPE occurs, it is due to the
  810.     # lack of errno being set to 0 by some libc's. (see bug 4942)
  811.     set x
  812. } {100}
  814. test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
  815.     catch {destroy .s}
  816.     scale .s -cursor trek
  817.     destroy .s
  818. } {}
  820. test scale-18.2 {Scale button 1 events [Bug 787065]} 
  821.     -setup {
  822.         catch {destroy .s}
  823.         set y 5
  824.         scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
  825.         pack .s
  826.         tkwait visibility .s
  827.         set ::error {}
  828.         proc bgerror {args} {set ::error $args}
  829.     } 
  830.     -body {
  831.         list [catch {
  832.             event generate .s <1> -x 0 -y 0
  833.             event generate .s <ButtonRelease-1> -x 0 -y 0
  834.             update
  835.             set ::error
  836.         } msg] $msg
  837.     } 
  838.     -cleanup {
  839.         unset ::error
  840.         rename bgerror {}
  841.         catch {destroy .s}
  842.     } 
  843.     -result {0 {}}
  845. test scale-18.3 {Scale button 2 events [Bug 787065]} 
  846.     -setup {
  847.         catch {destroy .s}
  848.         set y 5
  849.         scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
  850.         pack .s
  851.         tkwait visibility .s
  852.         set ::error {}
  853.         proc bgerror {args} {set ::error $args}
  854.     } 
  855.     -body {
  856.         list [catch {
  857.             event generate .s <2> -x 0 -y 0
  858.             event generate .s <ButtonRelease-2> -x 0 -y 0
  859.             update
  860.             set ::error
  861.         } msg] $msg
  862.     } 
  863.     -cleanup {
  864.         unset ::error
  865.         rename bgerror {}
  866.         catch {destroy .s}
  867.     } 
  868.     -result {0 {}}
  870. catch {destroy .s}
  871. option clear
  873. # cleanup
  874. ::tcltest::cleanupTests
  875. return