home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / scale.test < prev    next >
Encoding:
Text File  |  1995-05-21  |  24.2 KB  |  803 lines
  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-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) scale.test 1.14 95/03/22 09:29:38
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19. wm geometry . {}
  20. raise .
  21.  
  22. scale .s -from 100 -to 300
  23. pack .s
  24. update
  25. set i 1
  26. foreach test {
  27.     {-activebackground #ff0000 #ff0000 non-existent
  28.         {unknown color name "non-existent"}}
  29.     {-background #ff0000 #ff0000 non-existent
  30.         {unknown color name "non-existent"}}
  31.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  32.     {-bigincrement 12.2 12.2 badValue
  33.         {expected floating-point number but got "badValue"}}
  34.     {-bg #ff0000 #ff0000 non-existent
  35.         {unknown color name "non-existent"}}
  36.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  37.     {-command "set x" {set x} {} {}}
  38.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  39.     {-digits 5 5 badValue {expected integer but got "badValue"}}
  40.     {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
  41.     {-font fixed fixed badValue {font "badValue" doesn't exist}}
  42.     {-foreground green green badValue {unknown color name "badValue"}}
  43.     {-from -15.0 -15.0 badValue
  44.         {expected floating-point number but got "badValue"}}
  45.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  46.     {-highlightcolor #123456 #123456 non-existent
  47.         {unknown color name "non-existent"}}
  48.     {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
  49.     {-label "Some text" {Some text} {} {}}
  50.     {-length 130 130 badValue {bad screen distance "badValue"}}
  51.     {-orient horizontal horizontal badValue
  52.         {bad orientation "badValue": must be vertical or horizontal}}
  53.     {-orient horizontal horizontal {} {}}
  54.     {-relief ridge ridge badValue {bad relief type "badValue":  must be flat, groove, raised, ridge, or sunken}}
  55.     {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
  56.     {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
  57.     {-resolution 2.0 2.0 badValue
  58.         {expected floating-point number but got "badValue"}}
  59.     {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
  60.     {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
  61.     {-state disabled disabled badValue
  62.         {bad state value "badValue":  must be normal, active, or disabled}}
  63.     {-state normal normal {} {}}
  64.     {-takefocus "any string" "any string" {} {}}
  65.     {-tickinterval 4.3 4.0 badValue
  66.         {expected floating-point number but got "badValue"}}
  67.     {-to 14.9 15.0 badValue
  68.         {expected floating-point number but got "badValue"}}
  69.     {-troughcolor #ff0000 #ff0000 non-existent
  70.         {unknown color name "non-existent"}}
  71.     {-variable x x {} {}}
  72.     {-width 32 32 badValue {bad screen distance "badValue"}}
  73. } {
  74.     set name [lindex $test 0]
  75.     test scale-1.$i {configuration options} {
  76.     .s configure $name [lindex $test 1]
  77.     lindex [.s configure $name] 4
  78.     } [lindex $test 2]
  79.     incr i
  80.     if {[lindex $test 3] != ""} {
  81.     test scale-1.$i {configuration options} {
  82.         list [catch {.s configure $name [lindex $test 3]} msg] $msg
  83.     } [list 1 [lindex $test 4]]
  84.     }
  85.     .s configure $name [lindex [.s configure $name] 3]
  86.     incr i
  87. }
  88.  
  89. destroy .s
  90. test scale-2.1 {Tk_ScaleCmd procedure} {
  91.     list [catch {scale} msg] $msg
  92. } {1 {wrong # args: should be "scale pathName ?options?"}}
  93. test scale-2.2 {Tk_ScaleCmd procedure} {
  94.     list [catch {scale foo} msg] $msg [winfo child .]
  95. } {1 {bad window path name "foo"} {}}
  96. test scale-2.3 {Tk_ScaleCmd procedure} {
  97.     list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
  98. } {1 {unknown option "-gorp"} {}}
  99.  
  100. scale .s -from 100 -to 200
  101. pack .s
  102. update idletasks
  103. test scale-3.1 {ScaleWidgetCmd procedure} {
  104.     list [catch {.s} msg] $msg
  105. } {1 {wrong # args: should be ".s option ?arg arg ...?"}}
  106. test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
  107.     list [catch {.s cget} msg] $msg
  108. } {1 {wrong # args: should be ".s cget option"}}
  109. test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
  110.     list [catch {.s cget a b} msg] $msg
  111. } {1 {wrong # args: should be ".s cget option"}}
  112. test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
  113.     list [catch {.s cget -gorp} msg] $msg
  114. } {1 {unknown option "-gorp"}}
  115. test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
  116.     .s cget -highlightthickness
  117. } {2}
  118. test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
  119.     list [llength [.s configure]] [lindex [.s configure] 5]
  120. } {32 {-borderwidth borderWidth BorderWidth 2 2}}
  121. test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
  122.     list [catch {.s configure -foo} msg] $msg
  123. } {1 {unknown option "-foo"}}
  124. test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
  125.     list [catch {.s configure -borderwidth 2 -bg} msg] $msg
  126. } {1 {value for "-bg" missing}}
  127. test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
  128.     list [catch {.s coords a b} msg] $msg
  129. } {1 {wrong # args: should be ".s coords ?value?"}}
  130. test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
  131.     list [catch {.s coords bad} msg] $msg
  132. } {1 {expected floating-point number but got "bad"}}
  133. if $doNonPortableTests {
  134.     # These tests are non-portable due to variations in font sizes.
  135.  
  136.     test scale-3.11 {ScaleWidgetCmd procedure} {
  137.     .s set 120
  138.     .s coords
  139.     } {37 34}
  140.     test scale-3.12 {ScaleWidgetCmd procedure, coords option} {
  141.     .s configure -orient horizontal
  142.     update
  143.     .s set 120
  144.     .s coords
  145.     } {34 32}
  146. }
  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. if $doNonPortableTests {
  184.     # This test is non-portable due to variations in font sizes.
  185.  
  186.     test scale-3.23 {ScaleWidgetCmd procedure, identify option} {
  187.     .s set 120
  188.     list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
  189.     } {trough1 slider trough2 {}}
  190. }
  191. test scale-3.24 {ScaleWidgetCmd procedure, set option} {
  192.     list [catch {.s set} msg] $msg
  193. } {1 {wrong # args: should be ".s set value"}}
  194. test scale-3.25 {ScaleWidgetCmd procedure, set option} {
  195.     list [catch {.s set a b} msg] $msg
  196. } {1 {wrong # args: should be ".s set value"}}
  197. test scale-3.26 {ScaleWidgetCmd procedure, set option} {
  198.     list [catch {.s set bad} msg] $msg
  199. } {1 {expected floating-point number but got "bad"}}
  200. test scale-3.27 {ScaleWidgetCmd procedure, set option} {
  201.     .s set 142
  202. } {}
  203. test scale-3.28 {ScaleWidgetCmd procedure, set option} {
  204.     .s set 118
  205.     .s configure -state disabled
  206.     .s set 181
  207.     .s configure -state normal
  208.     .s get
  209. } {118}
  210. test scale-3.29 {ScaleWidgetCmd procedure} {
  211.     list [catch {.s dumb} msg] $msg
  212. } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
  213. test scale-3.30 {ScaleWidgetCmd procedure} {
  214.     list [catch {.s c} msg] $msg
  215. } {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
  216. test scale-3.31 {ScaleWidgetCmd procedure} {
  217.     list [catch {.s co} msg] $msg
  218. } {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
  219. test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
  220.     proc kill args {
  221.     destroy .s
  222.     }
  223.     catch {destroy .s}
  224.     scale .s -variable x -from 0 -to 100 -orient horizontal
  225.     pack .s
  226.     update
  227.     .s configure -command kill
  228.     .s set 55
  229. } {}
  230.  
  231. test scale-4.1 {DestroyScale procedure} {
  232.     catch {destroy .s}
  233.     set x 50
  234.     scale .s -variable x -from 0 -to 100 -orient horizontal
  235.     pack .s
  236.     update
  237.     destroy .s
  238.     list [catch {set x foo} msg] $msg $x
  239. } {0 foo foo}
  240.  
  241. test scale-5.1 {ConfigureScale procedure} {
  242.     catch {destroy .s}
  243.     set x 66
  244.     set y 77
  245.     scale .s -variable x -from 0 -to 100
  246.     pack .s
  247.     update
  248.     .s configure -variable y
  249.     list [catch {set x foo} msg] $msg $x [.s get]
  250. } {0 foo foo 77}
  251. test scale-5.2 {ConfigureScale procedure} {
  252.     catch {destroy .s}
  253.     scale .s -from 0 -to 100
  254.     list [catch {.s configure -foo bar} msg] $msg
  255. } {1 {unknown option "-foo"}}
  256. test scale-5.3 {ConfigureScale procedure} {
  257.     catch {destroy .s}
  258.     catch {unset x}
  259.     scale .s -from 0 -to 100 -variable x
  260.     set result $x
  261.     lappend result [.s get]
  262.     set x 92
  263.     lappend result [.s get]
  264.     .s set 3
  265.     lappend result $x
  266.     unset x
  267.     lappend result [catch {set x} msg] $msg
  268. } {0 0 92 3 0 3}
  269. test scale-5.4 {ConfigureScale procedure} {
  270.     catch {destroy .s}
  271.     scale .s -from 0 -to 100
  272.     list [catch {.s configure -orient dumb} msg] $msg
  273. } {1 {bad orientation "dumb": must be vertical or horizontal}}
  274. test scale-5.5 {ConfigureScale procedure} {
  275.     catch {destroy .s}
  276.     scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
  277.     list [.s cget -from] [.s cget -to] [.s cget -tickinterval]
  278. } {1.1 1.9 0.8}
  279. test scale-5.6 {ConfigureScale procedure} {
  280.     catch {destroy .s}
  281.     scale .s -from 1 -to 10 -tickinterval -2
  282.     pack .s
  283.     set result [lindex [.s configure -tickinterval] 4]
  284.     .s configure -from 10 -to 1 -tickinterval 2
  285.     lappend result [lindex [.s configure -tickinterval] 4]
  286. } {2.0 -2.0}
  287. test scale-5.7 {ConfigureScale procedure} {
  288.     catch {destroy .s}
  289.     list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
  290. } {1 {bad state value "bogus":  must be normal, active, or disabled}}
  291.  
  292. catch {destroy .s}
  293. scale .s -orient horizontal -length 200
  294. pack .s
  295. test scale-6.1 {ComputeFormat procedure} {
  296.     .s configure -from 10 -to 100 -resolution 10
  297.     .s set 49.3
  298.     .s get
  299. } {50}
  300. test scale-6.2 {ComputeFormat procedure} {
  301.     .s configure -from 100 -to 1000 -resolution 100
  302.     .s set 493
  303.     .s get
  304. } {500}
  305. test scale-6.3 {ComputeFormat procedure} {
  306.     .s configure -from 1000 -to 10000 -resolution 1000
  307.     .s set 4930
  308.     .s get
  309. } {5000}
  310. test scale-6.4 {ComputeFormat procedure} {
  311.     .s configure -from 10000 -to 100000 -resolution 10000
  312.     .s set 49000
  313.     .s get
  314. } {50000}
  315. test scale-6.5 {ComputeFormat procedure} {
  316.     .s configure -from 100000 -to 1000000 -resolution 100000
  317.     .s set 493000
  318.     .s get
  319. } {500000}
  320. test scale-6.6 {ComputeFormat procedure} {
  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.     .s get
  329. } {5.0e+09}
  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.     .s get
  359. } {6.0e-06}
  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.     .s get
  369. } {6.0e-06}
  370. test scale-6.16 {ComputeFormat procedure} {
  371.     .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
  372.     .s set .00006
  373.     .s get
  374. } {6e-05}
  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}
  395.  
  396. if $doNonPortableTests {
  397.     # These tests are non-portable due to variations in font sizes.
  398.  
  399.     test scale-7.1 {ComputeScaleGeometry procedure} {
  400.     catch {destroy .s}
  401.     scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
  402.     pack .s
  403.     update
  404.     list [winfo reqwidth .s] [winfo reqheight .s]
  405.     } {86 458}
  406.     test scale-7.2 {ComputeScaleGeometry procedure} {
  407.     catch {destroy .s}
  408.     scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
  409.     pack .s
  410.     update
  411.     list [winfo reqwidth .s] [winfo reqheight .s]
  412.     } {164 108}
  413.     test scale-7.3 {ComputeScaleGeometry procedure} {
  414.     catch {destroy .s}
  415.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
  416.         -sliderlength 10
  417.     pack .s
  418.     update
  419.     list [winfo reqwidth .s] [winfo reqheight .s]
  420.     } {22 108}
  421.     test scale-7.4 {ComputeScaleGeometry procedure} {
  422.     catch {destroy .s}
  423.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
  424.         -relief sunken
  425.     pack .s
  426.     update
  427.     list [winfo reqwidth .s] [winfo reqheight .s]
  428.     } {39 114}
  429.     test scale-7.5 {ComputeScaleGeometry procedure} {
  430.     catch {destroy .s}
  431.     scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
  432.     pack .s
  433.     update
  434.     list [winfo reqwidth .s] [winfo reqheight .s]
  435.     } {458 63}
  436.     test scale-7.6 {ComputeScaleGeometry procedure} {
  437.     catch {destroy .s}
  438.     scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
  439.         -tick 500
  440.     pack .s
  441.     update
  442.     list [winfo reqwidth .s] [winfo reqheight .s]
  443.     } {108 82}
  444.     test scale-7.7 {ComputeScaleGeometry procedure} {
  445.     catch {destroy .s}
  446.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
  447.     pack .s
  448.     update
  449.     list [winfo reqwidth .s] [winfo reqheight .s]
  450.     } {108 27}
  451. }
  452. test scale-7.8 {ComputeScaleGeometry procedure} {
  453.     catch {destroy .s}
  454.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
  455.         -relief raised
  456.     pack .s
  457.     update
  458.     list [winfo reqwidth .s] [winfo reqheight .s]
  459. } {114 39}
  460.  
  461. if $doNonPortableTests {
  462.     # These tests are non-portable due to variations in font sizes.
  463.  
  464.     test scale-8.1 {ScaleElement procedure} {
  465.     catch {destroy .s}
  466.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  467.     pack .s
  468.     .s set 30
  469.     update
  470.     list [.s identify 50 52] [.s identify 51 52] [.s identify 67 52] \
  471.         [.s identify 68 52]
  472.     } {{} trough1 trough1 {}}
  473.     test scale-8.2 {ScaleElement procedure} {
  474.     catch {destroy .s}
  475.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  476.     pack .s
  477.     .s set 30
  478.     update
  479.     list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
  480.         [.s identify 60 303]
  481.     } {{} trough1 trough2 {}}
  482.     test scale-8.3 {ScaleElement procedure} {
  483.     catch {destroy .s}
  484.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  485.     pack .s
  486.     .s set 30
  487.     update
  488.     list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
  489.         [.s identify 60 114] \
  490.     } {trough1 slider slider trough2}
  491. }
  492. test scale-8.4 {ScaleElement procedure} {
  493.     catch {destroy .s}
  494.     scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
  495.         -highlightthickness 1 -length 300 -showvalue 0
  496.     pack .s
  497.     .s set 30
  498.     update
  499.     list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
  500.         [.s identify 23 40] \
  501. } {{} trough1 trough1 {}}
  502. if $doNonPortableTests {
  503.     # These tests are non-portable due to variations in font sizes.
  504.  
  505.     test scale-8.5 {ScaleElement procedure} {
  506.     catch {destroy .s}
  507.     scale .s -from 0 -to 100 -orient horizontal -bd 1 \
  508.         -highlightthickness 2 -tick 20 -sliderlength 20 \
  509.         -length 200 -label Test
  510.     pack .s
  511.     .s set 30
  512.     update
  513.     list [.s identify 150 38] [.s identify 150 39] [.s identify 150 55] \
  514.         [.s identify 150 56]
  515.     } {{} trough2 trough2 {}}
  516.     test scale-8.6 {ScaleElement procedure} {
  517.     catch {destroy .s}
  518.     scale .s -from 0 -to 100 -orient horizontal -bd 2 \
  519.         -highlightthickness 1 -tick 20 -length 200
  520.     pack .s
  521.     .s set 30
  522.     update
  523.     list [.s identify 150 21] [.s identify 150 22] [.s identify 150 40] \
  524.         [.s identify 150 41]
  525.     } {{} trough2 trough2 {}}
  526. }
  527. test scale-8.7 {ScaleElement procedure} {
  528.     catch {destroy .s}
  529.     scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
  530.         -length 200 -width 10 -showvalue 0
  531.     pack .s
  532.     .s set 30
  533.     update
  534.     list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
  535.         [.s identify 30 24]
  536. } {{} trough1 trough1 {}}
  537. test scale-8.8 {ScaleElement procedure} {
  538.     catch {destroy .s}
  539.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
  540.         -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  541.     pack .s
  542.     .s set 30
  543.     update
  544.     list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
  545.         [.s identify 203 28]
  546. } {{} trough1 trough2 {}}
  547. test scale-8.9 {ScaleElement procedure} {
  548.     catch {destroy .s}
  549.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
  550.         -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  551.     pack .s
  552.     .s set 80
  553.     update
  554.     list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
  555.         [.s identify 166 28]
  556. } {trough1 slider slider trough2}
  557.  
  558. catch {destroy .s}
  559. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
  560. pack .s
  561. update
  562. test scale-9.1 {PixelToValue procedure} {
  563.     .s get 47 0
  564. } 0
  565. test scale-9.2 {PixelToValue procedure} {
  566.     .s get -10 9
  567. } 0
  568. test scale-9.3 {PixelToValue procedure} {
  569.     .s get -10 12
  570. } 1
  571. test scale-9.4 {PixelToValue procedure} {
  572.     .s get -10 46
  573. } 35
  574. test scale-9.5 {PixelToValue procedure} {
  575.     .s get -10 110
  576. } 99
  577. test scale-9.6 {PixelToValue procedure} {
  578.     .s get -10 111
  579. } 100
  580. test scale-9.7 {PixelToValue procedure} {
  581.     .s get -10 112
  582. } 100
  583. test scale-9.8 {PixelToValue procedure} {
  584.     .s get -10 154
  585. } 100
  586. .s configure -orient horizontal
  587. update
  588. test scale-9.9 {PixelToValue procedure} {
  589.     .s get 76 152
  590. } 65
  591.  
  592. if $doNonPortableTests {
  593.     # These tests are non-portable due to variations in font sizes.
  594.  
  595.     test scale-10.1 {ValueToPixel procedure} {
  596.     catch {destroy .s}
  597.     scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
  598.         -orient horizontal -label Test -tick 20
  599.     pack .s
  600.     update
  601.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  602.     } {{16 49} {56 49} {116 49}}
  603.     test scale-10.2 {ValueToPixel procedure} {
  604.     catch {destroy .s}
  605.     scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
  606.         -orient vertical -label Test -tick 20
  607.     pack .s
  608.     update
  609.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  610.     } {{59 114} {59 74} {59 14}}
  611. }
  612.  
  613. test scale-11.1 {ScaleEventProc procedure} {
  614.     proc killScale value {
  615.     global x
  616.     if {$value > 30} {
  617.         destroy .s1
  618.         lappend x [winfo exists .s1] [info commands .s1]
  619.     }
  620.     }
  621.     catch {destroy .s1}
  622.     set x initial
  623.     scale .s1 -from 0 -to 100 -command killScale
  624.     .s1 set 20
  625.     pack .s1
  626.     update idletasks
  627.     lappend x [winfo exists .s1]
  628.     .s1 set 40
  629.     update idletasks
  630.     rename killScale {}
  631.     set x
  632. } {initial 1 0 {}}
  633. test scale-11.2 {ScaleEventProc procedure} {
  634.     eval destroy [winfo children .]
  635.     scale .s1 -bg #543210
  636.     rename .s1 .s2
  637.     set x {}
  638.     lappend x [winfo children .]
  639.     lappend x [.s2 cget -bg]
  640.     destroy .s1
  641.     lappend x [info command .s*] [winfo children .]
  642. } {.s1 #543210 {} {}}
  643.  
  644. test scale-12.1 {ScaleCmdDeletedProc procedure} {
  645.     eval destroy [winfo children .]
  646.     scale .s1
  647.     rename .s1 {}
  648.     list [info command .s*] [winfo children .]
  649. } {{} {}}
  650.  
  651. catch {destroy .s}
  652. scale .s -from 0 -to 100 -command {set x} -variable y
  653. pack .s
  654. update
  655. proc varTrace args {
  656.     global traceInfo
  657.     set traceInfo $args
  658. }
  659. test scale-13.1 {SetScaleValue procedure} {
  660.     set x xyzzy
  661.     .s set 44
  662.     set result [list $x $y]
  663.     update
  664.     lappend result $x $y
  665. } {xyzzy 44 44 44}
  666. test scale-13.2 {SetScaleValue procedure} {
  667.     .s set -3
  668.     .s get
  669. } 0
  670. test scale-13.3 {SetScaleValue procedure} {
  671.     .s set 105
  672.     .s get
  673. } 100
  674. .s configure -from 100 -to 0
  675. test scale-13.4 {SetScaleValue procedure} {
  676.     .s set -3
  677.     .s get
  678. } 0
  679. test scale-13.5 {SetScaleValue procedure} {
  680.     .s set 105
  681.     .s get
  682. } 100
  683. test scale-13.6 {SetScaleValue procedure} {
  684.     .s set 50
  685.     update
  686.     trace variable y w varTrace
  687.     set traceInfo empty
  688.     set x untouched
  689.     .s set 50
  690.     update
  691.     list $x $traceInfo
  692. } {untouched empty}
  693.  
  694. catch {destroy .s}
  695. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
  696. pack .s
  697. update
  698. .s configure -resolution 4.0
  699. update
  700. test scale-14.1 {RoundToResolution procedure} {
  701.     .s get 84 152
  702. } 72
  703. test scale-14.2 {RoundToResolution procedure} {
  704.     .s get 86 152
  705. } 76
  706. .s configure -from 100 -to 0
  707. update
  708. test scale-14.3 {RoundToResolution procedure} {
  709.     .s get 84 152
  710. } 28
  711. test scale-14.4 {RoundToResolution procedure} {
  712.     .s get 86 152
  713. } 24
  714. .s configure -from -100 -to 0
  715. update
  716. test scale-14.5 {RoundToResolution procedure} {
  717.     .s get 84 152
  718. } -28
  719. test scale-14.6 {RoundToResolution procedure} {
  720.     .s get 86 152
  721. } -24
  722. .s configure -from 0 -to -100
  723. update
  724. test scale-14.7 {RoundToResolution procedure} {
  725.     .s get 84 152
  726. } -72
  727. test scale-14.8 {RoundToResolution procedure} {
  728.     .s get 86 152
  729. } -76
  730. .s configure -from 0 -to 2.25 -resolution 0
  731. update
  732. test scale-14.9 {RoundToResolution procedure} {
  733.     .s get 84 152
  734. } 1.64
  735. test scale-14.10 {RoundToResolution procedure} {
  736.     .s get 86 152
  737. } 1.69
  738. .s configure -from 0 -to 225 -resolution 0  -digits 5
  739. update
  740. test scale-14.11 {RoundToResolution procedure} {
  741.     .s get 84 152
  742. } 164.25
  743. test scale-14.12 {RoundToResolution procedure} {
  744.     .s get 86 152
  745. } 168.75
  746.  
  747. test scale-15.1 {ScaleVarProc procedure} {
  748.     catch {destroy .s}
  749.     set y -130
  750.     scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
  751.     pack .s
  752.     set y
  753. } -130
  754. test scale-15.2 {ScaleVarProc procedure} {
  755.     catch {destroy .s}
  756.     set y -130
  757.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  758.     pack .s
  759.     set y -87
  760.     .s get
  761. } -87
  762. test scale-15.3 {ScaleVarProc procedure} {
  763.     catch {destroy .s}
  764.     set y -130
  765.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  766.     pack .s
  767.     list [catch {set y 40q} msg] $msg [.s get]
  768. } {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
  769. test scale-15.4 {ScaleVarProc procedure} {
  770.     catch {destroy .s}
  771.     set y 1
  772.     scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
  773.     pack .s
  774.     list [catch {set y x} msg] $msg [.s get]
  775. } {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
  776. test scale-15.5 {ScaleVarProc procedure, variable deleted} {
  777.     catch {destroy .s}
  778.     set y 6
  779.     scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
  780.         -command "set x"
  781.     pack .s
  782.     update
  783.     set x untouched
  784.     unset y
  785.     update
  786.     list [catch {set y} msg] $msg [.s get] $x
  787. } {0 6 6 untouched}
  788. test scale-15.6 {ScaleVarProc procedure, don't call -command} {
  789.     catch {destroy .s}
  790.     set y 6
  791.     scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
  792.         -command "set x"
  793.     pack .s
  794.     update
  795.     set x untouched
  796.     set y 60
  797.     update
  798.     list $x [.s get]
  799. } {untouched 60}
  800.  
  801. catch {destroy .s}
  802. concat {}
  803.