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