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 $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18# Create entries in the option database to be sure that geometry options 19# like border width have predictable values. 20 21option add *Scale.borderWidth 2 22option add *Scale.highlightThickness 2 23option add *Scale.font {Helvetica -12 bold} 24 25scale .s -from 100 -to 300 26pack .s 27update 28set i 1 29foreach 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} 92destroy .s 93 94test scale-2.1 {Tk_ScaleCmd procedure} { 95 list [catch {scale} msg] $msg 96} {1 {wrong # args: should be "scale pathName ?options?"}} 97test scale-2.2 {Tk_ScaleCmd procedure} { 98 list [catch {scale foo} msg] $msg [winfo child .] 99} {1 {bad window path name "foo"} {}} 100test scale-2.3 {Tk_ScaleCmd procedure} { 101 list [catch {scale .s -gorp dumb} msg] $msg [winfo child .] 102} {1 {unknown option "-gorp"} {}} 103 104scale .s -from 100 -to 200 105pack .s 106update idletasks 107test scale-3.1 {ScaleWidgetCmd procedure} { 108 list [catch {.s} msg] $msg 109} {1 {wrong # args: should be ".s option ?arg arg ...?"}} 110test scale-3.2 {ScaleWidgetCmd procedure, cget option} { 111 list [catch {.s cget} msg] $msg 112} {1 {wrong # args: should be ".s cget option"}} 113test 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"}} 116test scale-3.4 {ScaleWidgetCmd procedure, cget option} { 117 list [catch {.s cget -gorp} msg] $msg 118} {1 {unknown option "-gorp"}} 119test scale-3.5 {ScaleWidgetCmd procedure, cget option} { 120 .s cget -highlightthickness 121} {2} 122test scale-3.6 {ScaleWidgetCmd procedure, configure option} { 123 list [llength [.s configure]] [lindex [.s configure] 6] 124} {33 {-command command Command {} {}}} 125test scale-3.7 {ScaleWidgetCmd procedure, configure option} { 126 list [catch {.s configure -foo} msg] $msg 127} {1 {unknown option "-foo"}} 128test scale-3.8 {ScaleWidgetCmd procedure, configure option} { 129 list [catch {.s configure -borderwidth 2 -bg} msg] $msg 130} {1 {value for "-bg" missing}} 131test 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?"}} 134test scale-3.10 {ScaleWidgetCmd procedure, coords option} { 135 list [catch {.s coords bad} msg] $msg 136} {1 {expected floating-point number but got "bad"}} 137test scale-3.11 {ScaleWidgetCmd procedure} {fonts} { 138 .s set 120 139 .s coords 140} {38 34} 141test 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 148update 149test 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?"}} 152test 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?"}} 155test scale-3.15 {ScaleWidgetCmd procedure, get option} { 156 list [catch {.s get a 11} msg] $msg 157} {1 {expected integer but got "a"}} 158test scale-3.16 {ScaleWidgetCmd procedure, get option} { 159 list [catch {.s get 12 b} msg] $msg 160} {1 {expected integer but got "b"}} 161test scale-3.17 {ScaleWidgetCmd procedure, get option} { 162 .s set 133 163 .s get 164} 133 165test 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 171test scale-3.19 {ScaleWidgetCmd procedure, identify option} { 172 list [catch {.s identify} msg] $msg 173} {1 {wrong # args: should be ".s identify x y"}} 174test 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"}} 177test scale-3.21 {ScaleWidgetCmd procedure, identify option} { 178 list [catch {.s identify boo 16} msg] $msg 179} {1 {expected integer but got "boo"}} 180test scale-3.22 {ScaleWidgetCmd procedure, identify option} { 181 list [catch {.s identify 17 bad} msg] $msg 182} {1 {expected integer but got "bad"}} 183test 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 {}} 187test scale-3.24 {ScaleWidgetCmd procedure, set option} { 188 list [catch {.s set} msg] $msg 189} {1 {wrong # args: should be ".s set value"}} 190test 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"}} 193test scale-3.26 {ScaleWidgetCmd procedure, set option} { 194 list [catch {.s set bad} msg] $msg 195} {1 {expected floating-point number but got "bad"}} 196test scale-3.27 {ScaleWidgetCmd procedure, set option} { 197 .s set 142 198} {} 199test 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} 206test 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}} 209test 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}} 212test 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}} 215test 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} {} 226 227test 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} 236 237test 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} 247test 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"}} 252test 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} 265test 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}} 270test 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} 276test 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} 284test 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}} 288 289catch {destroy .s} 290scale .s -orient horizontal -length 200 291pack .s 292test scale-6.1 {ComputeFormat procedure} { 293 .s configure -from 10 -to 100 -resolution 10 294 .s set 49.3 295 .s get 296} {50} 297test scale-6.2 {ComputeFormat procedure} { 298 .s configure -from 100 -to 1000 -resolution 100 299 .s set 493 300 .s get 301} {500} 302test scale-6.3 {ComputeFormat procedure} { 303 .s configure -from 1000 -to 10000 -resolution 1000 304 .s set 4930 305 .s get 306} {5000} 307test scale-6.4 {ComputeFormat procedure} { 308 .s configure -from 10000 -to 100000 -resolution 10000 309 .s set 49000 310 .s get 311} {50000} 312test scale-6.5 {ComputeFormat procedure} { 313 .s configure -from 100000 -to 1000000 -resolution 100000 314 .s set 493000 315 .s get 316} {500000} 317test scale-6.6 {ComputeFormat procedure} {nonPortable} { 318 # This test is non-portable because some platforms format the 319 # result as 5e+06. 320 321 .s configure -from 1000000 -to 10000000 -resolution 1000000 322 .s set 4930000 323 .s get 324} {5000000} 325test 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 330test scale-6.8 {ComputeFormat procedure} { 331 .s configure -from .1 -to 1 -resolution .1 332 .s set .6 333 .s get 334} {0.6} 335test scale-6.9 {ComputeFormat procedure} { 336 .s configure -from .01 -to .1 -resolution .01 337 .s set .06 338 .s get 339} {0.06} 340test scale-6.10 {ComputeFormat procedure} { 341 .s configure -from .001 -to .01 -resolution .001 342 .s set .006 343 .s get 344} {0.006} 345test scale-6.11 {ComputeFormat procedure} { 346 .s configure -from .0001 -to .001 -resolution .0001 347 .s set .0006 348 .s get 349} {0.0006} 350test scale-6.12 {ComputeFormat procedure} { 351 .s configure -from .00001 -to .0001 -resolution .00001 352 .s set .00006 353 .s get 354} {0.00006} 355test 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} 360test scale-6.14 {ComputeFormat procedure} { 361 .s configure -to .00001 -from .0001 -resolution .00001 362 .s set .00006 363 .s get 364} {0.00006} 365test 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} 370test 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} 375test 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} 380test 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} 385test 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} 390test 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 396test 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} 403test 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} 410test 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} 418test 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} 426test 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} 433test 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} 441test 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} 448test 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} 456 457test 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 {}} 466test 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 {}} 475test 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} 484test 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 {}} 494test 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 {}} 505test 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 {}} 515test 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 {}} 525test 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 {}} 535test 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} 545 546catch {destroy .s} 547scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 548pack .s 549update 550test scale-9.1 {PixelToValue procedure} { 551 .s get 46 0 552} 0 553test scale-9.2 {PixelToValue procedure} { 554 .s get -10 9 555} 0 556test scale-9.3 {PixelToValue procedure} { 557 .s get -10 12 558} 1 559test scale-9.4 {PixelToValue procedure} { 560 .s get -10 46 561} 35 562test scale-9.5 {PixelToValue procedure} { 563 .s get -10 110 564} 99 565test scale-9.6 {PixelToValue procedure} { 566 .s get -10 111 567} 100 568test scale-9.7 {PixelToValue procedure} { 569 .s get -10 112 570} 100 571test scale-9.8 {PixelToValue procedure} { 572 .s get -10 154 573} 100 574.s configure -orient horizontal 575update 576test scale-9.9 {PixelToValue procedure} { 577 .s get 76 152 578} 65 579 580test 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}} 588test 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}} 596 597test 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 {}} 617test 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 {} {}} 627 628test scale-12.1 {ScaleCmdDeletedProc procedure} { 629 deleteWindows 630 scale .s1 631 rename .s1 {} 632 list [info command .s*] [winfo children .] 633} {{} {}} 634 635catch {destroy .s} 636scale .s -from 0 -to 100 -command {set x} -variable y 637pack .s 638update 639proc varTrace args { 640 global traceInfo 641 set traceInfo $args 642} 643test 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} 650test scale-13.2 {SetScaleValue procedure} { 651 .s set -3 652 .s get 653} 0 654test scale-13.3 {SetScaleValue procedure} { 655 .s set 105 656 .s get 657} 100 658.s configure -from 100 -to 0 659test scale-13.4 {SetScaleValue procedure} { 660 .s set -3 661 .s get 662} 0 663test scale-13.5 {SetScaleValue procedure} { 664 .s set 105 665 .s get 666} 100 667test 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} 677 678catch {destroy .s} 679scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal 680pack .s 681update 682.s configure -resolution 4.0 683update 684test scale-14.1 {RoundToResolution procedure} { 685 .s get 84 152 686} 72 687test scale-14.2 {RoundToResolution procedure} { 688 .s get 86 152 689} 76 690.s configure -from 100 -to 0 691update 692test scale-14.3 {RoundToResolution procedure} { 693 .s get 84 152 694} 28 695test scale-14.4 {RoundToResolution procedure} { 696 .s get 86 152 697} 24 698.s configure -from -100 -to 0 699update 700test scale-14.5 {RoundToResolution procedure} { 701 .s get 84 152 702} -28 703test scale-14.6 {RoundToResolution procedure} { 704 .s get 86 152 705} -24 706.s configure -from 0 -to -100 707update 708test scale-14.7 {RoundToResolution procedure} { 709 .s get 84 152 710} -72 711test scale-14.8 {RoundToResolution procedure} { 712 .s get 86 152 713} -76 714.s configure -from 0 -to 2.25 -resolution 0 715update 716test scale-14.9 {RoundToResolution procedure} { 717 .s get 84 152 718} 1.64 719test scale-14.10 {RoundToResolution procedure} { 720 .s get 86 152 721} 1.69 722.s configure -from 0 -to 225 -resolution 0 -digits 5 723update 724test scale-14.11 {RoundToResolution procedure} { 725 .s get 84 152 726} 164.25 727test scale-14.12 {RoundToResolution procedure} { 728 .s get 86 152 729} 168.75 730 731test 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 738test 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 746test 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} 753test 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} 760test 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} 772test 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} 784 785set l [interp hidden] 786deleteWindows 787 788test 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] 795 796test 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. 801 802 set x {} 803 scale .s -from 100 -to 300 804 pack .s 805 update 806 .s configure -variable x ;# CRASH! -> Floating point exception 807 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} 813 814test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} { 815 catch {destroy .s} 816 scale .s -cursor trek 817 destroy .s 818} {} 819 820test 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 {}} 844 845test 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 {}} 869 870catch {destroy .s} 871option clear 872 873# cleanup 874::tcltest::cleanupTests 875return 876