# This file is a Tcl script to test out the "scale" command # of Tk. It is organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: scale.test,v 1.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands # Create entries in the option database to be sure that geometry options # like border width have predictable values. option add *Scale.borderWidth 2 option add *Scale.highlightThickness 2 option add *Scale.font {Helvetica -12 bold} scale .s -from 100 -to 300 pack .s update set i 1 foreach test { {-activebackground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} {-bigincrement 12.5 12.5 badValue {expected floating-point number but got "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-command "set x" {set x} {} {}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-digits 5 5 badValue {expected integer but got "badValue"}} {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} {-font fixed fixed {} {font "" doesn't exist}} {-foreground green green badValue {unknown color name "badValue"}} {-from -15.0 -15.0 badValue {expected floating-point number but got "badValue"}} {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} {-highlightcolor #123456 #123456 non-existent {unknown color name "non-existent"}} {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} {-label "Some text" {Some text} {} {}} {-length 130 130 badValue {bad screen distance "badValue"}} {-orient horizontal horizontal badValue {bad orient "badValue": must be horizontal or vertical}} {-orient horizontal horizontal {} {}} {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-repeatdelay 14 14 bogus {expected integer but got "bogus"}} {-repeatinterval 14 14 bogus {expected integer but got "bogus"}} {-resolution 2.0 2.0 badValue {expected floating-point number but got "badValue"}} {-showvalue 0 0 badValue {expected boolean value but got "badValue"}} {-sliderlength 86 86 badValue {bad screen distance "badValue"}} {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-state d disabled badValue {bad state "badValue": must be active, disabled, or normal}} {-state n normal {} {}} {-takefocus "any string" "any string" {} {}} {-tickinterval 4.3 4.0 badValue {expected floating-point number but got "badValue"}} {-to 14.9 15.0 badValue {expected floating-point number but got "badValue"}} {-troughcolor #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-variable x x {} {}} {-width 32 32 badValue {bad screen distance "badValue"}} } { set name [lindex $test 0] test scale-1.$i {configuration options} { .s configure $name [lindex $test 1] lindex [.s configure $name] 4 } [lindex $test 2] incr i if {[lindex $test 3] != ""} { test scale-1.$i {configuration options} { list [catch {.s configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .s configure $name [lindex [.s configure $name] 3] incr i } destroy .s test scale-2.1 {Tk_ScaleCmd procedure} { list [catch {scale} msg] $msg } {1 {wrong # args: should be "scale pathName ?options?"}} test scale-2.2 {Tk_ScaleCmd procedure} { list [catch {scale foo} msg] $msg [winfo child .] } {1 {bad window path name "foo"} {}} test scale-2.3 {Tk_ScaleCmd procedure} { list [catch {scale .s -gorp dumb} msg] $msg [winfo child .] } {1 {unknown option "-gorp"} {}} scale .s -from 100 -to 200 pack .s update idletasks test scale-3.1 {ScaleWidgetCmd procedure} { list [catch {.s} msg] $msg } {1 {wrong # args: should be ".s option ?arg arg ...?"}} test scale-3.2 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget} msg] $msg } {1 {wrong # args: should be ".s cget option"}} test scale-3.3 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget a b} msg] $msg } {1 {wrong # args: should be ".s cget option"}} test scale-3.4 {ScaleWidgetCmd procedure, cget option} { list [catch {.s cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} test scale-3.5 {ScaleWidgetCmd procedure, cget option} { .s cget -highlightthickness } {2} test scale-3.6 {ScaleWidgetCmd procedure, configure option} { list [llength [.s configure]] [lindex [.s configure] 6] } {33 {-command command Command {} {}}} test scale-3.7 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -foo} msg] $msg } {1 {unknown option "-foo"}} test scale-3.8 {ScaleWidgetCmd procedure, configure option} { list [catch {.s configure -borderwidth 2 -bg} msg] $msg } {1 {value for "-bg" missing}} test scale-3.9 {ScaleWidgetCmd procedure, coords option} { list [catch {.s coords a b} msg] $msg } {1 {wrong # args: should be ".s coords ?value?"}} test scale-3.10 {ScaleWidgetCmd procedure, coords option} { list [catch {.s coords bad} msg] $msg } {1 {expected floating-point number but got "bad"}} test scale-3.11 {ScaleWidgetCmd procedure} {fonts} { .s set 120 .s coords } {38 34} test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} { .s configure -orient horizontal update .s set 120 .s coords } {34 31} .s configure -orient vertical update test scale-3.13 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a} msg] $msg } {1 {wrong # args: should be ".s get ?x y?"}} test scale-3.14 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a b c} msg] $msg } {1 {wrong # args: should be ".s get ?x y?"}} test scale-3.15 {ScaleWidgetCmd procedure, get option} { list [catch {.s get a 11} msg] $msg } {1 {expected integer but got "a"}} test scale-3.16 {ScaleWidgetCmd procedure, get option} { list [catch {.s get 12 b} msg] $msg } {1 {expected integer but got "b"}} test scale-3.17 {ScaleWidgetCmd procedure, get option} { .s set 133 .s get } 133 test scale-3.18 {ScaleWidgetCmd procedure, get option} { .s configure -resolution 0.5 .s set 150 .s get 37 34 } 119.5 .s configure -resolution 1 test scale-3.19 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify} msg] $msg } {1 {wrong # args: should be ".s identify x y"}} test scale-3.20 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify 1 2 3} msg] $msg } {1 {wrong # args: should be ".s identify x y"}} test scale-3.21 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify boo 16} msg] $msg } {1 {expected integer but got "boo"}} test scale-3.22 {ScaleWidgetCmd procedure, identify option} { list [catch {.s identify 17 bad} msg] $msg } {1 {expected integer but got "bad"}} test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} { .s set 120 list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80] } {trough1 slider trough2 {}} test scale-3.24 {ScaleWidgetCmd procedure, set option} { list [catch {.s set} msg] $msg } {1 {wrong # args: should be ".s set value"}} test scale-3.25 {ScaleWidgetCmd procedure, set option} { list [catch {.s set a b} msg] $msg } {1 {wrong # args: should be ".s set value"}} test scale-3.26 {ScaleWidgetCmd procedure, set option} { list [catch {.s set bad} msg] $msg } {1 {expected floating-point number but got "bad"}} test scale-3.27 {ScaleWidgetCmd procedure, set option} { .s set 142 } {} test scale-3.28 {ScaleWidgetCmd procedure, set option} { .s set 118 .s configure -state disabled .s set 181 .s configure -state normal .s get } {118} test scale-3.29 {ScaleWidgetCmd procedure} { list [catch {.s dumb} msg] $msg } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}} test scale-3.30 {ScaleWidgetCmd procedure} { list [catch {.s c} msg] $msg } {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}} test scale-3.31 {ScaleWidgetCmd procedure} { list [catch {.s co} msg] $msg } {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}} test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} { proc kill args { destroy .s } catch {destroy .s} scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update .s configure -command kill .s set 55 } {} test scale-4.1 {DestroyScale procedure} { catch {destroy .s} set x 50 scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update destroy .s list [catch {set x foo} msg] $msg $x } {0 foo foo} test scale-5.1 {ConfigureScale procedure} { catch {destroy .s} set x 66 set y 77 scale .s -variable x -from 0 -to 100 pack .s update .s configure -variable y list [catch {set x foo} msg] $msg $x [.s get] } {0 foo foo 77} test scale-5.2 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 0 -to 100 list [catch {.s configure -foo bar} msg] $msg } {1 {unknown option "-foo"}} test scale-5.3 {ConfigureScale procedure} { catch {destroy .s} catch {unset x} scale .s -from 0 -to 100 -variable x set result $x lappend result [.s get] set x 92 lappend result [.s get] .s set 3 lappend result $x unset x lappend result [catch {set x} msg] $msg } {0 0 92 3 0 3} test scale-5.4 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 0 -to 100 list [catch {.s configure -orient dumb} msg] $msg } {1 {bad orient "dumb": must be horizontal or vertical}} test scale-5.5 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76 list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \ [format %.1f [.s cget -tickinterval]] } {1.1 1.9 0.8} test scale-5.6 {ConfigureScale procedure} { catch {destroy .s} scale .s -from 1 -to 10 -tickinterval -2 pack .s set result [lindex [.s configure -tickinterval] 4] .s configure -from 10 -to 1 -tickinterval 2 lappend result [lindex [.s configure -tickinterval] 4] } {2.0 -2.0} test scale-5.7 {ConfigureScale procedure} { catch {destroy .s} list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg } {1 {bad state "bogus": must be active, disabled, or normal}} catch {destroy .s} scale .s -orient horizontal -length 200 pack .s test scale-6.1 {ComputeFormat procedure} { .s configure -from 10 -to 100 -resolution 10 .s set 49.3 .s get } {50} test scale-6.2 {ComputeFormat procedure} { .s configure -from 100 -to 1000 -resolution 100 .s set 493 .s get } {500} test scale-6.3 {ComputeFormat procedure} { .s configure -from 1000 -to 10000 -resolution 1000 .s set 4930 .s get } {5000} test scale-6.4 {ComputeFormat procedure} { .s configure -from 10000 -to 100000 -resolution 10000 .s set 49000 .s get } {50000} test scale-6.5 {ComputeFormat procedure} { .s configure -from 100000 -to 1000000 -resolution 100000 .s set 493000 .s get } {500000} test scale-6.6 {ComputeFormat procedure} {nonPortable} { # This test is non-portable because some platforms format the # result as 5e+06. .s configure -from 1000000 -to 10000000 -resolution 1000000 .s set 4930000 .s get } {5000000} test scale-6.7 {ComputeFormat procedure} { .s configure -from 1000000000 -to 10000000000 -resolution 1000000000 .s set 4930000000 expr {[.s get] == 5.0e+09} } 1 test scale-6.8 {ComputeFormat procedure} { .s configure -from .1 -to 1 -resolution .1 .s set .6 .s get } {0.6} test scale-6.9 {ComputeFormat procedure} { .s configure -from .01 -to .1 -resolution .01 .s set .06 .s get } {0.06} test scale-6.10 {ComputeFormat procedure} { .s configure -from .001 -to .01 -resolution .001 .s set .006 .s get } {0.006} test scale-6.11 {ComputeFormat procedure} { .s configure -from .0001 -to .001 -resolution .0001 .s set .0006 .s get } {0.0006} test scale-6.12 {ComputeFormat procedure} { .s configure -from .00001 -to .0001 -resolution .00001 .s set .00006 .s get } {0.00006} test scale-6.13 {ComputeFormat procedure} { .s configure -from .000001 -to .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} } {1} test scale-6.14 {ComputeFormat procedure} { .s configure -to .00001 -from .0001 -resolution .00001 .s set .00006 .s get } {0.00006} test scale-6.15 {ComputeFormat procedure} { .s configure -to .000001 -from .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} } {1} test scale-6.16 {ComputeFormat procedure} { .s configure -from .00001 -to .0001 -resolution .00001 -digits 1 .s set .00006 expr {[.s get] == 6e-05} } {1} test scale-6.17 {ComputeFormat procedure} { .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3 .s set 49300000 .s get } {50000000} test scale-6.18 {ComputeFormat procedure} { .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0 .s set .111111111 .s get } {0.11} test scale-6.19 {ComputeFormat procedure} { .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0 .s set 1001.23456789 .s get } {1001.23} test scale-6.20 {ComputeFormat procedure} { .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0 .s set 1001.23456789 .s get } {1001.235} test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} { catch {destroy .s} scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {88 458} test scale-7.2 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {168 108} test scale-7.3 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \ -sliderlength 10 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {22 108} test scale-7.4 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \ -relief sunken pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {39 114} test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} { catch {destroy .s} scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {458 61} test scale-7.6 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \ -tick 500 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {108 79} test scale-7.7 {ComputeScaleGeometry procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {108 27} test scale-7.8 {ComputeScaleGeometry procedure} { catch {destroy .s} scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \ -relief raised -highlightthickness 2 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] } {114 39} test scale-8.1 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \ [.s identify 71 52] } {{} trough1 trough1 {}} test scale-8.2 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \ [.s identify 60 303] } {{} trough1 trough2 {}} test scale-8.3 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \ [.s identify 60 114] \ } {trough1 slider slider trough2} test scale-8.4 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \ -highlightthickness 1 -length 300 -showvalue 0 pack .s .s set 30 update list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \ [.s identify 23 40] \ } {{} trough1 trough1 {}} test scale-8.5 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 \ -highlightthickness 2 -tick 20 -sliderlength 20 \ -length 200 -label Test pack .s .s set 30 update list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \ [.s identify 150 54] } {{} trough2 trough2 {}} test scale-8.6 {ScaleElement procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 2 \ -highlightthickness 1 -tick 20 -length 200 pack .s .s set 30 update list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \ [.s identify 150 40] } {{} trough2 trough2 {}} test scale-8.7 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \ -length 200 -width 10 -showvalue 0 pack .s .s set 30 update list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \ [.s identify 30 24] } {{} trough1 trough1 {}} test scale-8.8 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 30 update list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \ [.s identify 203 28] } {{} trough1 trough2 {}} test scale-8.9 {ScaleElement procedure} { catch {destroy .s} scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 80 update list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \ [.s identify 166 28] } {trough1 slider slider trough2} catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 pack .s update test scale-9.1 {PixelToValue procedure} { .s get 46 0 } 0 test scale-9.2 {PixelToValue procedure} { .s get -10 9 } 0 test scale-9.3 {PixelToValue procedure} { .s get -10 12 } 1 test scale-9.4 {PixelToValue procedure} { .s get -10 46 } 35 test scale-9.5 {PixelToValue procedure} { .s get -10 110 } 99 test scale-9.6 {PixelToValue procedure} { .s get -10 111 } 100 test scale-9.7 {PixelToValue procedure} { .s get -10 112 } 100 test scale-9.8 {PixelToValue procedure} { .s get -10 154 } 100 .s configure -orient horizontal update test scale-9.9 {PixelToValue procedure} { .s get 76 152 } 65 test scale-10.1 {ValueToPixel procedure} {fonts} { catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \ -orient horizontal -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] } {{16 47} {56 47} {116 47}} test scale-10.2 {ValueToPixel procedure} {fonts} { catch {destroy .s} scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \ -orient vertical -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] } {{62 114} {62 74} {62 14}} test scale-11.1 {ScaleEventProc procedure} { proc killScale value { global x if {$value > 30} { destroy .s1 lappend x [winfo exists .s1] [info commands .s1] } } catch {destroy .s1} set x initial scale .s1 -from 0 -to 100 -command killScale .s1 set 20 pack .s1 update idletasks lappend x [winfo exists .s1] .s1 set 40 update idletasks rename killScale {} set x } {initial 1 0 {}} test scale-11.2 {ScaleEventProc procedure} { deleteWindows scale .s1 -bg #543210 rename .s1 .s2 set x {} lappend x [winfo children .] lappend x [.s2 cget -bg] destroy .s1 lappend x [info command .s*] [winfo children .] } {.s1 #543210 {} {}} test scale-12.1 {ScaleCmdDeletedProc procedure} { deleteWindows scale .s1 rename .s1 {} list [info command .s*] [winfo children .] } {{} {}} catch {destroy .s} scale .s -from 0 -to 100 -command {set x} -variable y pack .s update proc varTrace args { global traceInfo set traceInfo $args } test scale-13.1 {SetScaleValue procedure} { set x xyzzy .s set 44 set result [list $x $y] update lappend result $x $y } {xyzzy 44 44 44} test scale-13.2 {SetScaleValue procedure} { .s set -3 .s get } 0 test scale-13.3 {SetScaleValue procedure} { .s set 105 .s get } 100 .s configure -from 100 -to 0 test scale-13.4 {SetScaleValue procedure} { .s set -3 .s get } 0 test scale-13.5 {SetScaleValue procedure} { .s set 105 .s get } 100 test scale-13.6 {SetScaleValue procedure} { .s set 50 update trace variable y w varTrace set traceInfo empty set x untouched .s set 50 update list $x $traceInfo } {untouched empty} catch {destroy .s} scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal pack .s update .s configure -resolution 4.0 update test scale-14.1 {RoundToResolution procedure} { .s get 84 152 } 72 test scale-14.2 {RoundToResolution procedure} { .s get 86 152 } 76 .s configure -from 100 -to 0 update test scale-14.3 {RoundToResolution procedure} { .s get 84 152 } 28 test scale-14.4 {RoundToResolution procedure} { .s get 86 152 } 24 .s configure -from -100 -to 0 update test scale-14.5 {RoundToResolution procedure} { .s get 84 152 } -28 test scale-14.6 {RoundToResolution procedure} { .s get 86 152 } -24 .s configure -from 0 -to -100 update test scale-14.7 {RoundToResolution procedure} { .s get 84 152 } -72 test scale-14.8 {RoundToResolution procedure} { .s get 86 152 } -76 .s configure -from 0 -to 2.25 -resolution 0 update test scale-14.9 {RoundToResolution procedure} { .s get 84 152 } 1.64 test scale-14.10 {RoundToResolution procedure} { .s get 86 152 } 1.69 .s configure -from 0 -to 225 -resolution 0 -digits 5 update test scale-14.11 {RoundToResolution procedure} { .s get 84 152 } 164.25 test scale-14.12 {RoundToResolution procedure} { .s get 86 152 } 168.75 test scale-15.1 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from 0 -to -200 -variable y -orient horizontal -length 150 pack .s set y } -130 test scale-15.2 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s set y -87 .s get } -87 test scale-15.3 {ScaleVarProc procedure} { catch {destroy .s} set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s list [catch {set y 40q} msg] $msg [.s get] } {1 {can't set "y": can't assign non-numeric value to scale variable} -130} test scale-15.4 {ScaleVarProc procedure} { catch {destroy .s} set y 1 scale .s -from 1 -to 0 -variable y -orient horizontal -length 150 pack .s list [catch {set y x} msg] $msg [.s get] } {1 {can't set "y": can't assign non-numeric value to scale variable} 1} test scale-15.5 {ScaleVarProc procedure, variable deleted} { catch {destroy .s} set y 6 scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \ -command "set x" pack .s update set x untouched unset y update list [catch {set y} msg] $msg [.s get] $x } {0 6 6 untouched} test scale-15.6 {ScaleVarProc procedure, don't call -command} { catch {destroy .s} set y 6 scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \ -command "set x" pack .s update set x untouched set y 60 update list $x [.s get] } {untouched 60} set l [interp hidden] deleteWindows test scale-16.1 {scale widget vs hidden commands} { catch {destroy .s} scale .s interp hide {} .s destroy .s list [winfo children .] [interp hidden] } [list {} $l] test scale-17.1 {bug fix 1786} { # Perhaps x is set to {}, depending on what other tests have run. # If x is unset, or set to something not convertable to a double, # then the scale try to initialize its value with the contents # of uninitialized memory. Sometimes that causes an FPE. set x {} scale .s -from 100 -to 300 pack .s update .s configure -variable x ;# CRASH! -> Floating point exception # Bug 4833 changed the result to realize that x should pick up # a value from the scale. In an FPE occurs, it is due to the # lack of errno being set to 0 by some libc's. (see bug 4942) set x } {100} test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} { catch {destroy .s} scale .s -cursor trek destroy .s } {} test scale-18.2 {Scale button 1 events [Bug 787065]} \ -setup { catch {destroy .s} set y 5 scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 pack .s tkwait visibility .s set ::error {} proc bgerror {args} {set ::error $args} } \ -body { list [catch { event generate .s <1> -x 0 -y 0 event generate .s -x 0 -y 0 update set ::error } msg] $msg } \ -cleanup { unset ::error rename bgerror {} catch {destroy .s} } \ -result {0 {}} test scale-18.3 {Scale button 2 events [Bug 787065]} \ -setup { catch {destroy .s} set y 5 scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 pack .s tkwait visibility .s set ::error {} proc bgerror {args} {set ::error $args} } \ -body { list [catch { event generate .s <2> -x 0 -y 0 event generate .s -x 0 -y 0 update set ::error } msg] $msg } \ -cleanup { unset ::error rename bgerror {} catch {destroy .s} } \ -result {0 {}} catch {destroy .s} option clear # cleanup ::tcltest::cleanupTests return