1606 lines
49 KiB
Plaintext
1606 lines
49 KiB
Plaintext
# 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.
|
|
|
|
package require tcltest 2.2
|
|
namespace import ::tcltest::*
|
|
eval tcltest::configure $argv
|
|
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}
|
|
|
|
# Widget used in 1.* tests
|
|
scale .s -from 100 -to 300
|
|
pack .s
|
|
update
|
|
|
|
test scale-1.1 {configuration options} -body {
|
|
.s configure -activebackground #ff0000
|
|
.s cget -activebackground
|
|
} -cleanup {
|
|
.s configure -activebackground [lindex [.s configure -activebackground] 3]
|
|
} -result {#ff0000}
|
|
test scale-1.2 {configuration options} -body {
|
|
.s configure -activebackground non-existent
|
|
} -returnCodes error -result {unknown color name "non-existent"}
|
|
test scale-1.3 {configuration options} -body {
|
|
.s configure -background #ff0000
|
|
.s cget -background
|
|
} -cleanup {
|
|
.s configure -background [lindex [.s configure -background] 3]
|
|
} -result {#ff0000}
|
|
test scale-1.4 {configuration options} -body {
|
|
.s configure -background non-existent
|
|
} -returnCodes error -result {unknown color name "non-existent"}
|
|
test scale-1.5 {configuration options} -body {
|
|
.s configure -bd 4
|
|
.s cget -bd
|
|
} -cleanup {
|
|
.s configure -bd [lindex [.s configure -bd] 3]
|
|
} -result {4}
|
|
test scale-1.6 {configuration options} -body {
|
|
.s configure -bd badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
test scale-1.7 {configuration options} -body {
|
|
.s configure -bigincrement 12.5
|
|
.s cget -bigincrement
|
|
} -cleanup {
|
|
.s configure -bigincrement [lindex [.s configure -bigincrement] 3]
|
|
} -result {12.5}
|
|
test scale-1.8 {configuration options} -body {
|
|
.s configure -bigincrement badValue
|
|
} -returnCodes error -result {expected floating-point number but got "badValue"}
|
|
test scale-1.9 {configuration options} -body {
|
|
.s configure -bg #ff0000
|
|
.s cget -bg
|
|
} -cleanup {
|
|
.s configure -bg [lindex [.s configure -bg] 3]
|
|
} -result {#ff0000}
|
|
test scale-1.10 {configuration options} -body {
|
|
.s configure -bg non-existent
|
|
} -returnCodes error -result {unknown color name "non-existent"}
|
|
test scale-1.11 {configuration options} -body {
|
|
.s configure -borderwidth 1.3
|
|
.s cget -borderwidth
|
|
} -cleanup {
|
|
.s configure -borderwidth [lindex [.s configure -borderwidth] 3]
|
|
} -result {1}
|
|
test scale-1.12 {configuration options} -body {
|
|
.s configure -borderwidth badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
test scale-1.13 {configuration options} -body {
|
|
.s configure -command {set x}
|
|
.s cget -command
|
|
} -cleanup {
|
|
.s configure -command [lindex [.s configure -command] 3]
|
|
} -result {set x}
|
|
test scale-1.15 {configuration options} -body {
|
|
.s configure -cursor arrow
|
|
.s cget -cursor
|
|
} -cleanup {
|
|
.s configure -cursor [lindex [.s configure -cursor] 3]
|
|
} -result {arrow}
|
|
test scale-1.16 {configuration options} -body {
|
|
.s configure -cursor badValue
|
|
} -returnCodes error -result {bad cursor spec "badValue"}
|
|
test scale-1.17 {configuration options} -body {
|
|
.s configure -digits 5
|
|
.s cget -digits
|
|
} -cleanup {
|
|
.s configure -digits [lindex [.s configure -digits] 3]
|
|
} -result {5}
|
|
test scale-1.18 {configuration options} -body {
|
|
.s configure -digits badValue
|
|
} -returnCodes error -result {expected integer but got "badValue"}
|
|
test scale-1.19 {configuration options} -body {
|
|
.s configure -fg #00ff00
|
|
.s cget -fg
|
|
} -cleanup {
|
|
.s configure -fg [lindex [.s configure -fg] 3]
|
|
} -result {#00ff00}
|
|
test scale-1.20 {configuration options} -body {
|
|
.s configure -fg badValue
|
|
} -returnCodes error -result {unknown color name "badValue"}
|
|
test scale-1.21 {configuration options} -body {
|
|
.s configure -font fixed
|
|
.s cget -font
|
|
} -cleanup {
|
|
.s configure -font [lindex [.s configure -font] 3]
|
|
} -result {fixed}
|
|
test scale-1.23 {configuration options} -body {
|
|
.s configure -foreground green
|
|
.s cget -foreground
|
|
} -cleanup {
|
|
.s configure -foreground [lindex [.s configure -foreground] 3]
|
|
} -result {green}
|
|
test scale-1.24 {configuration options} -body {
|
|
.s configure -foreground badValue
|
|
} -returnCodes error -result {unknown color name "badValue"}
|
|
test scale-1.25 {configuration options} -body {
|
|
.s configure -from -15.0
|
|
.s cget -from
|
|
} -cleanup {
|
|
.s configure -from [lindex [.s configure -from] 3]
|
|
} -result {-15.0}
|
|
test scale-1.26 {configuration options} -body {
|
|
.s configure -from badValue
|
|
} -returnCodes error -result {expected floating-point number but got "badValue"}
|
|
test scale-1.27 {configuration options} -body {
|
|
.s configure -highlightbackground #112233
|
|
.s cget -highlightbackground
|
|
} -cleanup {
|
|
.s configure -highlightbackground [lindex [.s configure -highlightbackground] 3]
|
|
} -result {#112233}
|
|
test scale-1.28 {configuration options} -body {
|
|
.s configure -highlightbackground ugly
|
|
} -returnCodes error -result {unknown color name "ugly"}
|
|
test scale-1.29 {configuration options} -body {
|
|
.s configure -highlightcolor #123456
|
|
.s cget -highlightcolor
|
|
} -cleanup {
|
|
.s configure -highlightcolor [lindex [.s configure -highlightcolor] 3]
|
|
} -result {#123456}
|
|
test scale-1.30 {configuration options} -body {
|
|
.s configure -highlightcolor non-existent
|
|
} -returnCodes error -result {unknown color name "non-existent"}
|
|
test scale-1.31 {configuration options} -body {
|
|
.s configure -highlightthickness 2
|
|
.s cget -highlightthickness
|
|
} -cleanup {
|
|
.s configure -highlightthickness [lindex [.s configure -highlightthickness] 3]
|
|
} -result {2}
|
|
test scale-1.32 {configuration options} -body {
|
|
.s configure -highlightthickness badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
test scale-1.33 {configuration options} -body {
|
|
.s configure -label {Some text}
|
|
.s cget -label
|
|
} -cleanup {
|
|
.s configure -label [lindex [.s configure -label] 3]
|
|
} -result {Some text}
|
|
test scale-1.35 {configuration options} -body {
|
|
.s configure -length 130
|
|
.s cget -length
|
|
} -cleanup {
|
|
.s configure -length [lindex [.s configure -length] 3]
|
|
} -result {130}
|
|
test scale-1.36 {configuration options} -body {
|
|
.s configure -length badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
test scale-1.37 {configuration options} -body {
|
|
.s configure -orient horizontal
|
|
.s cget -orient
|
|
} -cleanup {
|
|
.s configure -orient [lindex [.s configure -orient] 3]
|
|
} -result {horizontal}
|
|
test scale-1.38 {configuration options} -body {
|
|
.s configure -orient badValue
|
|
} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical}
|
|
test scale-1.39 {configuration options} -body {
|
|
.s configure -orient horizontal
|
|
.s cget -orient
|
|
} -cleanup {
|
|
.s configure -orient [lindex [.s configure -orient] 3]
|
|
} -result {horizontal}
|
|
test scale-1.41 {configuration options} -body {
|
|
.s configure -relief ridge
|
|
.s cget -relief
|
|
} -cleanup {
|
|
.s configure -relief [lindex [.s configure -relief] 3]
|
|
} -result {ridge}
|
|
test scale-1.42 {configuration options} -body {
|
|
.s configure -relief badValue
|
|
} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
|
|
test scale-1.43 {configuration options} -body {
|
|
.s configure -repeatdelay 14
|
|
.s cget -repeatdelay
|
|
} -cleanup {
|
|
.s configure -repeatdelay [lindex [.s configure -repeatdelay] 3]
|
|
} -result {14}
|
|
test scale-1.44 {configuration options} -body {
|
|
.s configure -repeatdelay bogus
|
|
} -returnCodes error -result {expected integer but got "bogus"}
|
|
test scale-1.45 {configuration options} -body {
|
|
.s configure -repeatinterval 14
|
|
.s cget -repeatinterval
|
|
} -cleanup {
|
|
.s configure -repeatinterval [lindex [.s configure -repeatinterval] 3]
|
|
} -result {14}
|
|
test scale-1.46 {configuration options} -body {
|
|
.s configure -repeatinterval bogus
|
|
} -returnCodes error -result {expected integer but got "bogus"}
|
|
test scale-1.47 {configuration options} -body {
|
|
.s configure -resolution 2.0
|
|
.s cget -resolution
|
|
} -cleanup {
|
|
.s configure -resolution [lindex [.s configure -resolution] 3]
|
|
} -result {2.0}
|
|
test scale-1.48 {configuration options} -body {
|
|
.s configure -resolution badValue
|
|
} -returnCodes error -result {expected floating-point number but got "badValue"}
|
|
test scale-1.49 {configuration options} -body {
|
|
.s configure -showvalue 0
|
|
.s cget -showvalue
|
|
} -cleanup {
|
|
.s configure -showvalue [lindex [.s configure -showvalue] 3]
|
|
} -result {0}
|
|
test scale-1.50 {configuration options} -body {
|
|
.s configure -showvalue badValue
|
|
} -returnCodes error -result {expected boolean value but got "badValue"}
|
|
test scale-1.51 {configuration options} -body {
|
|
.s configure -sliderlength 86
|
|
.s cget -sliderlength
|
|
} -cleanup {
|
|
.s configure -sliderlength [lindex [.s configure -sliderlength] 3]
|
|
} -result {86}
|
|
test scale-1.52 {configuration options} -body {
|
|
.s configure -sliderlength badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
test scale-1.53 {configuration options} -body {
|
|
.s configure -sliderrelief raised
|
|
.s cget -sliderrelief
|
|
} -cleanup {
|
|
.s configure -sliderrelief [lindex [.s configure -sliderrelief] 3]
|
|
} -result {raised}
|
|
test scale-1.54 {configuration options} -body {
|
|
.s configure -sliderrelief badValue
|
|
} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
|
|
test scale-1.55 {configuration options} -body {
|
|
.s configure -state d
|
|
.s cget -state
|
|
} -cleanup {
|
|
.s configure -state [lindex [.s configure -state] 3]
|
|
} -result {disabled}
|
|
test scale-1.56 {configuration options} -body {
|
|
.s configure -state badValue
|
|
} -returnCodes error -result {bad state "badValue": must be active, disabled, or normal}
|
|
test scale-1.57 {configuration options} -body {
|
|
.s configure -state n
|
|
.s cget -state
|
|
} -cleanup {
|
|
.s configure -state [lindex [.s configure -state] 3]
|
|
} -result {normal}
|
|
test scale-1.59 {configuration options} -body {
|
|
.s configure -takefocus {any string}
|
|
.s cget -takefocus
|
|
} -cleanup {
|
|
.s configure -takefocus [lindex [.s configure -takefocus] 3]
|
|
} -result {any string}
|
|
test scale-1.61 {configuration options} -body {
|
|
.s configure -tickinterval 4.3
|
|
.s cget -tickinterval
|
|
} -cleanup {
|
|
.s configure -tickinterval [lindex [.s configure -tickinterval] 3]
|
|
} -result {4.0}
|
|
test scale-1.62 {configuration options} -body {
|
|
.s configure -tickinterval badValue
|
|
} -returnCodes error -result {expected floating-point number but got "badValue"}
|
|
test scale-1.63 {configuration options} -body {
|
|
.s configure -to 14.9
|
|
.s cget -to
|
|
} -cleanup {
|
|
.s configure -to [lindex [.s configure -to] 3]
|
|
} -result {15.0}
|
|
test scale-1.64 {configuration options} -body {
|
|
.s configure -to badValue
|
|
} -returnCodes error -result {expected floating-point number but got "badValue"}
|
|
test scale-1.65 {configuration options} -body {
|
|
.s configure -troughcolor #ff0000
|
|
.s cget -troughcolor
|
|
} -cleanup {
|
|
.s configure -troughcolor [lindex [.s configure -troughcolor] 3]
|
|
} -result {#ff0000}
|
|
test scale-1.66 {configuration options} -body {
|
|
.s configure -troughcolor non-existent
|
|
} -returnCodes error -result {unknown color name "non-existent"}
|
|
test scale-1.67 {configuration options} -body {
|
|
.s configure -variable x
|
|
.s cget -variable
|
|
} -cleanup {
|
|
.s configure -variable [lindex [.s configure -variable] 3]
|
|
} -result {x}
|
|
test scale-1.69 {configuration options} -body {
|
|
.s configure -width 32
|
|
.s cget -width
|
|
} -cleanup {
|
|
.s configure -width [lindex [.s configure -width] 3]
|
|
} -result {32}
|
|
test scale-1.70 {configuration options} -body {
|
|
.s configure -width badValue
|
|
} -returnCodes error -result {bad screen distance "badValue"}
|
|
destroy .s
|
|
|
|
|
|
test scale-2.1 {Tk_ScaleCmd procedure} -body {
|
|
scale
|
|
} -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"}
|
|
test scale-2.2 {Tk_ScaleCmd procedure} -body {
|
|
scale foo
|
|
} -returnCodes error -result {bad window path name "foo"}
|
|
test scale-2.3 {Tk_ScaleCmd procedure} -body {
|
|
catch {scale foo}
|
|
winfo child .
|
|
} -result {}
|
|
test scale-2.4 {Tk_ScaleCmd procedure} -body {
|
|
scale .s -gorp dumb
|
|
} -returnCodes error -result {unknown option "-gorp"}
|
|
test scale-2.5 {Tk_ScaleCmd procedure} -body {
|
|
catch {scale .s -gorp dumb}
|
|
winfo child .
|
|
} -result {}
|
|
|
|
|
|
# Widget used in 3.* tests
|
|
destroy .s
|
|
scale .s -from 100 -to 200
|
|
pack .s
|
|
update idletasks
|
|
test scale-3.1 {ScaleWidgetCmd procedure} -body {
|
|
.s
|
|
} -returnCodes error -result {wrong # args: should be ".s option ?arg ...?"}
|
|
test scale-3.2 {ScaleWidgetCmd procedure, cget option} -body {
|
|
.s cget
|
|
} -returnCodes error -result {wrong # args: should be ".s cget option"}
|
|
test scale-3.3 {ScaleWidgetCmd procedure, cget option} -body {
|
|
.s cget a b
|
|
} -returnCodes error -result {wrong # args: should be ".s cget option"}
|
|
test scale-3.4 {ScaleWidgetCmd procedure, cget option} -body {
|
|
.s cget -gorp
|
|
} -returnCodes error -result {unknown option "-gorp"}
|
|
test scale-3.5 {ScaleWidgetCmd procedure, cget option} -body {
|
|
.s configure -highlightthickness 2
|
|
.s cget -highlightthickness
|
|
} -result {2}
|
|
test scale-3.6 {ScaleWidgetCmd procedure, configure option} -body {
|
|
list [llength [.s configure]] [lindex [.s configure] 6]
|
|
} -result {33 {-command command Command {} {}}}
|
|
test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body {
|
|
.s configure -foo
|
|
} -returnCodes error -result {unknown option "-foo"}
|
|
test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body {
|
|
.s configure -borderwidth 2 -bg
|
|
} -returnCodes error -result {value for "-bg" missing}
|
|
test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body {
|
|
.s coords a b
|
|
} -returnCodes error -result {wrong # args: should be ".s coords ?value?"}
|
|
test scale-3.10 {ScaleWidgetCmd procedure, coords option} -body {
|
|
.s coords bad
|
|
} -returnCodes error -result {expected floating-point number but got "bad"}
|
|
test scale-3.11 {ScaleWidgetCmd procedure} -constraints {
|
|
fonts
|
|
} -body {
|
|
.s configure -from 100 -to 200
|
|
update idletasks
|
|
.s set 120
|
|
.s coords
|
|
} -result {38 34}
|
|
test scale-3.12 {ScaleWidgetCmd procedure, coords option} -constraints {
|
|
fonts
|
|
} -body {
|
|
.s configure -from 100 -to 200 -orient horizontal
|
|
update idletasks
|
|
.s set 120
|
|
.s coords
|
|
} -result {34 31}
|
|
test scale-3.13 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical
|
|
update
|
|
.s get a
|
|
} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
|
|
test scale-3.14 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical
|
|
update
|
|
.s get a b c
|
|
} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
|
|
test scale-3.15 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical
|
|
update
|
|
.s get a 11
|
|
} -returnCodes error -result {expected integer but got "a"}
|
|
test scale-3.16 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical
|
|
update
|
|
.s get 12 b
|
|
} -returnCodes error -result {expected integer but got "b"}
|
|
test scale-3.17 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical
|
|
update
|
|
.s set 133
|
|
.s get
|
|
} -result 133
|
|
test scale-3.18 {ScaleWidgetCmd procedure, get option} -body {
|
|
.s configure -orient vertical -resolution 0.5
|
|
update
|
|
.s set 150
|
|
.s get 37 34
|
|
} -result {119.5}
|
|
.s configure -resolution 1
|
|
test scale-3.19 {ScaleWidgetCmd procedure, identify option} -body {
|
|
.s identify
|
|
} -returnCodes error -result {wrong # args: should be ".s identify x y"}
|
|
test scale-3.20 {ScaleWidgetCmd procedure, identify option} -body {
|
|
.s identify 1 2 3
|
|
} -returnCodes error -result {wrong # args: should be ".s identify x y"}
|
|
test scale-3.21 {ScaleWidgetCmd procedure, identify option} -body {
|
|
.s identify boo 16
|
|
} -returnCodes error -result {expected integer but got "boo"}
|
|
test scale-3.22 {ScaleWidgetCmd procedure, identify option} -body {
|
|
.s identify 17 bad
|
|
} -returnCodes error -result {expected integer but got "bad"}
|
|
test scale-3.23 {ScaleWidgetCmd procedure, identify option} -constraints {
|
|
fonts
|
|
} -body {
|
|
.s configure -from 100 -to 200 -orient vertical -resolution 1
|
|
update
|
|
.s set 120
|
|
list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
|
|
} -result {trough1 slider trough2 {}}
|
|
test scale-3.24 {ScaleWidgetCmd procedure, set option} -body {
|
|
.s set
|
|
} -returnCodes error -result {wrong # args: should be ".s set value"}
|
|
test scale-3.25 {ScaleWidgetCmd procedure, set option} -body {
|
|
.s set a b
|
|
} -returnCodes error -result {wrong # args: should be ".s set value"}
|
|
test scale-3.26 {ScaleWidgetCmd procedure, set option} -body {
|
|
.s set bad
|
|
} -returnCodes error -result {expected floating-point number but got "bad"}
|
|
test scale-3.27 {ScaleWidgetCmd procedure, set option} -body {
|
|
.s configure -from 100 -to 200 -orient vertical -resolution 0.5
|
|
update
|
|
.s set 142
|
|
} -result {}
|
|
test scale-3.28 {ScaleWidgetCmd procedure, set option} -body {
|
|
.s configure -from 100 -to 200 -orient vertical -resolution 1
|
|
update
|
|
.s set 118
|
|
.s configure -state disabled
|
|
.s set 181
|
|
.s configure -state normal
|
|
.s get
|
|
} -result {118}
|
|
test scale-3.29 {ScaleWidgetCmd procedure} -body {
|
|
.s dumb
|
|
} -returnCodes error -result {bad option "dumb": must be cget, configure, coords, get, identify, or set}
|
|
test scale-3.30 {ScaleWidgetCmd procedure} -body {
|
|
.s c
|
|
} -returnCodes error -result {ambiguous option "c": must be cget, configure, coords, get, identify, or set}
|
|
test scale-3.31 {ScaleWidgetCmd procedure} -body {
|
|
.s co
|
|
} -returnCodes error -result {ambiguous option "co": must be cget, configure, coords, get, identify, or set}
|
|
destroy .s
|
|
|
|
test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup {
|
|
destroy .s
|
|
} -body {
|
|
proc kill args {
|
|
destroy .s
|
|
}
|
|
scale .s -variable x -from 0 -to 100 -orient horizontal
|
|
pack .s
|
|
update
|
|
.s configure -command kill
|
|
.s set 55
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {}
|
|
|
|
|
|
test scale-4.1 {DestroyScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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
|
|
} -result {0 foo foo}
|
|
|
|
|
|
test scale-5.1 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {0 foo foo 77}
|
|
test scale-5.2 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 100
|
|
.s configure -foo bar
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -returnCodes error -result {unknown option "-foo"}
|
|
test scale-5.3 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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 [set x]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {0 0 92 3 3}
|
|
test scale-5.4 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 100
|
|
.s configure -orient dumb
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -returnCodes error -result {bad orient "dumb": must be horizontal or vertical}
|
|
test scale-5.5 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {1.1 1.9 0.8}
|
|
test scale-5.6 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {2.0 -2.0}
|
|
test scale-5.7 {ConfigureScale procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 100 -state bogus
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal}
|
|
|
|
|
|
# Widget used in 6.* tests
|
|
destroy .s
|
|
scale .s -orient horizontal -length 200
|
|
pack .s
|
|
test scale-6.1 {ComputeFormat procedure} -body {
|
|
.s configure -from 10 -to 100 -resolution 10
|
|
.s set 49.3
|
|
.s get
|
|
} -result {50}
|
|
test scale-6.2 {ComputeFormat procedure} -body {
|
|
.s configure -from 100 -to 1000 -resolution 100
|
|
.s set 493
|
|
.s get
|
|
} -result {500}
|
|
test scale-6.3 {ComputeFormat procedure} -body {
|
|
.s configure -from 1000 -to 10000 -resolution 1000
|
|
.s set 4930
|
|
.s get
|
|
} -result {5000}
|
|
test scale-6.4 {ComputeFormat procedure} -body {
|
|
.s configure -from 10000 -to 100000 -resolution 10000
|
|
.s set 49000
|
|
.s get
|
|
} -result {50000}
|
|
test scale-6.5 {ComputeFormat procedure} -body {
|
|
.s configure -from 100000 -to 1000000 -resolution 100000
|
|
.s set 493000
|
|
.s get
|
|
} -result {500000}
|
|
test scale-6.6 {ComputeFormat procedure} -constraints {
|
|
nonPortable
|
|
} -body {
|
|
# 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
|
|
} -result {5000000}
|
|
test scale-6.7 {ComputeFormat procedure} -body {
|
|
.s configure -from 1000000000 -to 10000000000 -resolution 1000000000
|
|
.s set 4930000000
|
|
expr {[.s get] == 5.0e+09}
|
|
} -result 1
|
|
test scale-6.8 {ComputeFormat procedure} -body {
|
|
.s configure -from .1 -to 1 -resolution .1
|
|
.s set .6
|
|
.s get
|
|
} -result {0.6}
|
|
test scale-6.9 {ComputeFormat procedure} -body {
|
|
.s configure -from .01 -to .1 -resolution .01
|
|
.s set .06
|
|
.s get
|
|
} -result {0.06}
|
|
test scale-6.10 {ComputeFormat procedure} -body {
|
|
.s configure -from .001 -to .01 -resolution .001
|
|
.s set .006
|
|
.s get
|
|
} -result {0.006}
|
|
test scale-6.11 {ComputeFormat procedure} -body {
|
|
.s configure -from .0001 -to .001 -resolution .0001
|
|
.s set .0006
|
|
.s get
|
|
} -result {0.0006}
|
|
test scale-6.12 {ComputeFormat procedure} -body {
|
|
.s configure -from .00001 -to .0001 -resolution .00001
|
|
.s set .00006
|
|
.s get
|
|
} -result {0.00006}
|
|
test scale-6.13 {ComputeFormat procedure} -body {
|
|
.s configure -from .000001 -to .00001 -resolution .000001
|
|
.s set .000006
|
|
expr {[.s get] == 6.0e-06}
|
|
} -result {1}
|
|
test scale-6.14 {ComputeFormat procedure} -body {
|
|
.s configure -to .00001 -from .0001 -resolution .00001
|
|
.s set .00006
|
|
.s get
|
|
} -result {0.00006}
|
|
test scale-6.15 {ComputeFormat procedure} -body {
|
|
.s configure -to .000001 -from .00001 -resolution .000001
|
|
.s set .000006
|
|
expr {[.s get] == 6.0e-06}
|
|
} -result {1}
|
|
test scale-6.16 {ComputeFormat procedure} -body {
|
|
.s configure -from .00001 -to .0001 -resolution .00001 -digits 1
|
|
.s set .00006
|
|
expr {[.s get] == 6e-05}
|
|
} -result {1}
|
|
test scale-6.17 {ComputeFormat procedure} -body {
|
|
.s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
|
|
.s set 49300000
|
|
.s get
|
|
} -result {50000000}
|
|
test scale-6.18 {ComputeFormat procedure} -body {
|
|
.s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
|
|
.s set .111111111
|
|
.s get
|
|
} -result {0.11}
|
|
test scale-6.19 {ComputeFormat procedure} -body {
|
|
.s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
|
|
.s set 1001.23456789
|
|
.s get
|
|
} -result {1001.23}
|
|
test scale-6.20 {ComputeFormat procedure} -body {
|
|
.s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
|
|
.s set 1001.23456789
|
|
.s get
|
|
} -result {1001.235}
|
|
test scale-6.21 {ComputeFormat procedure} -body {
|
|
.s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200
|
|
.s set 1001.23456789
|
|
.s get
|
|
} -result {1001.235}
|
|
destroy .s
|
|
|
|
|
|
test scale-7.1 {ComputeScaleGeometry procedure} -constraints {
|
|
nonPortable fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {88 458}
|
|
test scale-7.2 {ComputeScaleGeometry procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {168 108}
|
|
test scale-7.3 {ComputeScaleGeometry procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
|
|
-sliderlength 10
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {22 108}
|
|
test scale-7.4 {ComputeScaleGeometry procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
|
|
-relief sunken
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {39 114}
|
|
test scale-7.5 {ComputeScaleGeometry procedure} -constraints {
|
|
nonPortable fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {458 61}
|
|
test scale-7.6 {ComputeScaleGeometry procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
|
|
-tick 500
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {108 79}
|
|
test scale-7.7 {ComputeScaleGeometry procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
|
|
pack .s
|
|
update
|
|
list [winfo reqwidth .s] [winfo reqheight .s]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {108 27}
|
|
test scale-7.8 {ComputeScaleGeometry procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {114 39}
|
|
|
|
|
|
test scale-8.1 {ScaleElement procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough1 trough1 {}}
|
|
test scale-8.2 {ScaleElement procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough1 trough2 {}}
|
|
test scale-8.3 {ScaleElement procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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] \
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {trough1 slider slider trough2}
|
|
test scale-8.4 {ScaleElement procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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] \
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough1 trough1 {}}
|
|
test scale-8.5 {ScaleElement procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough2 trough2 {}}
|
|
test scale-8.6 {ScaleElement procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough2 trough2 {}}
|
|
test scale-8.7 {ScaleElement procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough1 trough1 {}}
|
|
test scale-8.8 {ScaleElement procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} trough1 trough2 {}}
|
|
test scale-8.9 {ScaleElement procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {trough1 slider slider trough2}
|
|
|
|
|
|
#widget used in 9.* tests
|
|
destroy .s
|
|
pack [scale .s]
|
|
test scale-9.1 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get 46 0
|
|
} -result 0
|
|
test scale-9.2 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 9
|
|
} -result 0
|
|
test scale-9.3 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 12
|
|
} -result 1
|
|
test scale-9.4 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 46
|
|
} -result 35
|
|
test scale-9.5 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 110
|
|
} -result 99
|
|
test scale-9.6 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 111
|
|
} -result 100
|
|
test scale-9.7 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 112
|
|
} -result 100
|
|
test scale-9.8 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
|
|
update
|
|
.s get -10 154
|
|
} -result 100
|
|
test scale-9.9 {PixelToValue procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal
|
|
update
|
|
.s get 76 152
|
|
} -result 65
|
|
destroy .s
|
|
|
|
|
|
test scale-10.1 {ValueToPixel procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{16 47} {56 47} {116 47}}
|
|
test scale-10.2 {ValueToPixel procedure} -constraints {
|
|
fonts
|
|
} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{62 114} {62 74} {62 14}}
|
|
|
|
|
|
test scale-11.1 {ScaleEventProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
proc killScale value {
|
|
global x
|
|
if {$value > 30} {
|
|
destroy .s1
|
|
lappend x [winfo exists .s1] [info commands .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
|
|
return $x
|
|
} -cleanup {
|
|
rename killScale {}
|
|
deleteWindows
|
|
} -result {initial 1 0 {}}
|
|
test scale-11.2 {ScaleEventProc procedure} -setup {
|
|
deleteWindows
|
|
set x {}
|
|
} -body {
|
|
scale .s1 -bg #543210
|
|
rename .s1 .s2
|
|
lappend x [winfo children .]
|
|
lappend x [.s2 cget -bg]
|
|
destroy .s1
|
|
lappend x [info command .s*] [winfo children .]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {.s1 #543210 {} {}}
|
|
|
|
test scale-12.1 {ScaleCmdDeletedProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s1
|
|
rename .s1 {}
|
|
list [info command .s*] [winfo children .]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {{} {}}
|
|
|
|
|
|
# Widget used in 13.* tests
|
|
destroy .s
|
|
pack [scale .s]
|
|
update
|
|
test scale-13.1 {SetScaleValue procedure} -body {
|
|
.s configure -from 0 -to 100 -command {set x} -variable y
|
|
update
|
|
set x xyzzy
|
|
.s set 44
|
|
set result [list $x $y]
|
|
update
|
|
lappend result $x $y
|
|
} -result {xyzzy 44 44 44}
|
|
test scale-13.2 {SetScaleValue procedure} -body {
|
|
.s set -3
|
|
.s get
|
|
} -result 0
|
|
test scale-13.3 {SetScaleValue procedure} -body {
|
|
.s set 105
|
|
.s get
|
|
} -result 100
|
|
.s configure -from 100 -to 0
|
|
test scale-13.4 {SetScaleValue procedure} -body {
|
|
.s set -3
|
|
.s get
|
|
} -result 0
|
|
test scale-13.5 {SetScaleValue procedure} -body {
|
|
.s set 105
|
|
.s get
|
|
} -result 100
|
|
test scale-13.6 {SetScaleValue procedure} -body {
|
|
proc varTrace args {
|
|
global traceInfo
|
|
set traceInfo $args
|
|
}
|
|
.s configure -from 0 -to 100 -command {set x} -variable y
|
|
update
|
|
|
|
.s set 50
|
|
update
|
|
trace variable y w varTrace
|
|
set traceInfo empty
|
|
set x untouched
|
|
.s set 50
|
|
update
|
|
list $x $traceInfo
|
|
} -result {untouched empty}
|
|
|
|
|
|
# Widget used in 14.* tests
|
|
destroy .s
|
|
pack [scale .s]
|
|
update
|
|
test scale-14.1 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 84 152
|
|
} -result 72
|
|
test scale-14.2 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 86 152
|
|
} -result 76
|
|
|
|
test scale-14.3 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 84 152
|
|
} -result 28
|
|
test scale-14.4 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 86 152
|
|
} -result 24
|
|
|
|
test scale-14.5 {RoundValueToResolution procedure} -body {
|
|
.s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 84 152
|
|
} -result {-28}
|
|
test scale-14.6 {RoundValueToResolution procedure} -body {
|
|
.s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 86 152
|
|
} -result {-24}
|
|
|
|
test scale-14.7 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 84 152
|
|
} -result {-72}
|
|
test scale-14.8 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 4.0
|
|
update
|
|
.s get 86 152
|
|
} -result {-76}
|
|
|
|
test scale-14.9 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 0
|
|
update
|
|
.s get 84 152
|
|
} -result {1.64}
|
|
test scale-14.10 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 0
|
|
update
|
|
.s get 86 152
|
|
} -result {1.69}
|
|
|
|
test scale-14.11 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 0 -digits 5
|
|
update
|
|
.s get 84 152
|
|
} -result {164.25}
|
|
test scale-14.12 {RoundValueToResolution procedure} -body {
|
|
.s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
|
|
-orient horizontal -resolution 0 -digits 5
|
|
update
|
|
.s get 86 152
|
|
} -result {168.75}
|
|
destroy .s
|
|
|
|
test scale-14.13 {RoundValueToResolution procedure, round-off errors} -setup {
|
|
# see [220665ffff], and duplicates [220265ffff] and [779559ffff]
|
|
set x NotSet
|
|
pack [scale .s -orient horizontal -resolution .1 -from -180 -to 180 -command "set x"]
|
|
update
|
|
} -body {
|
|
.s configure -background red
|
|
update
|
|
set x
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {NotSet}
|
|
|
|
test scale-14a.1 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup {
|
|
pack [scale .s -orient horizontal]
|
|
update
|
|
} -body {
|
|
.s configure -length 400 -bd 0 -from 1 -to 9 -resolution 2 -tickinterval 1
|
|
update
|
|
.s get 200 0
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {5}
|
|
test scale-14a.2 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup {
|
|
pack [scale .s -orient horizontal]
|
|
update
|
|
} -body {
|
|
.s configure -length 400 -bd 0 -from -1.5 -to 1.5 -resolution 1 \
|
|
-tickinterval 1 -digits 2
|
|
update
|
|
.s get 250 0
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {0.5}
|
|
|
|
|
|
test scale-15.1 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y -130
|
|
scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
return $y
|
|
} -result {-130}
|
|
test scale-15.2 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y -130
|
|
scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
set y -87
|
|
.s get
|
|
} -result {-87}
|
|
test scale-15.3 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y -130
|
|
scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
set y 40q
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
|
|
test scale-15.4 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y -130
|
|
scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
catch {set y 40q}
|
|
.s get
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {-130}
|
|
test scale-15.5 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y 1
|
|
scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
set y x
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
|
|
test scale-15.6 {ScaleVarProc procedure} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
set y 1
|
|
scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
catch {set y x}
|
|
.s get
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result 1
|
|
test scale-15.7 {ScaleVarProc procedure, variable deleted} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {0 6 6 untouched}
|
|
test scale-15.8 {ScaleVarProc procedure, don't call -command} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
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]
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {untouched 60}
|
|
|
|
|
|
test scale-16.1 {scale widget vs hidden commands} -body {
|
|
set l [interp hidden]
|
|
deleteWindows
|
|
scale .s
|
|
interp hide {} .s
|
|
destroy .s
|
|
set res1 [list [winfo children .] [interp hidden]]
|
|
set res2 [list {} $l]
|
|
expr {$res1 eq $res2}
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result 1
|
|
|
|
|
|
test scale-17.1 {bug fix 1786} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
# 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)
|
|
return $x
|
|
} -cleanup {
|
|
deleteWindows
|
|
} -result {100}
|
|
|
|
|
|
test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} -setup {
|
|
deleteWindows
|
|
} -body {
|
|
scale .s -cursor trek
|
|
destroy .s
|
|
} -result {}
|
|
|
|
test scale-18.2 {Scale button 1 events [Bug 787065]} -setup {
|
|
destroy .s
|
|
set ::error {}
|
|
proc bgerror {args} {set ::error $args}
|
|
} -body {
|
|
set y 5
|
|
scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
tkwait visibility .s
|
|
list [catch {
|
|
event generate .s <1> -x 0 -y 0
|
|
event generate .s <ButtonRelease-1> -x 0 -y 0
|
|
update
|
|
set ::error
|
|
} msg] $msg
|
|
} -cleanup {
|
|
unset ::error
|
|
rename bgerror {}
|
|
destroy .s
|
|
} -result {0 {}}
|
|
|
|
test scale-18.3 {Scale button 2 events [Bug 787065]} -setup {
|
|
destroy .s
|
|
set ::error {}
|
|
proc bgerror {args} {set ::error $args}
|
|
} -body {
|
|
set y 5
|
|
scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
|
|
pack .s
|
|
tkwait visibility .s
|
|
list [catch {
|
|
event generate .s <2> -x 0 -y 0
|
|
event generate .s <ButtonRelease-2> -x 0 -y 0
|
|
update
|
|
set ::error
|
|
} msg] $msg
|
|
} -cleanup {
|
|
unset ::error
|
|
rename bgerror {}
|
|
destroy .s
|
|
} -result {0 {}}
|
|
|
|
|
|
test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \
|
|
-setup {
|
|
catch {destroy .s}
|
|
catch {destroy .s1 .s2 .s3 .s4}
|
|
unset -nocomplain x1 x2 x3 x4 x y
|
|
scale .s1 -from 0 -to 100 -resolution 1 -variable x1 -digits 4 -orient horizontal -length 100
|
|
scale .s2 -from 0 -to 100 -resolution -1 -variable x2 -digits 4 -orient horizontal -length 100
|
|
scale .s3 -from 100 -to 0 -resolution 1 -variable x3 -digits 4 -orient horizontal -length 100
|
|
scale .s4 -from 100 -to 0 -resolution -1 -variable x4 -digits 4 -orient horizontal -length 100
|
|
pack .s1 .s2 .s3 .s4 -side left
|
|
update
|
|
} \
|
|
-body {
|
|
foreach {x y} [.s1 coord 50] {}
|
|
event generate .s1 <1> -x $x -y $y
|
|
event generate .s1 <ButtonRelease-1> -x $x -y $y
|
|
foreach {x y} [.s2 coord 50] {}
|
|
event generate .s2 <1> -x $x -y $y
|
|
event generate .s2 <ButtonRelease-1> -x $x -y $y
|
|
foreach {x y} [.s3 coord 50] {}
|
|
event generate .s3 <1> -x $x -y $y
|
|
event generate .s3 <ButtonRelease-1> -x $x -y $y
|
|
foreach {x y} [.s4 coord 50] {}
|
|
event generate .s4 <1> -x $x -y $y
|
|
event generate .s4 <ButtonRelease-1> -x $x -y $y
|
|
update
|
|
list $x1 $x2 $x3 $x4
|
|
} \
|
|
-cleanup {
|
|
unset x1 x2 x3 x4 x y
|
|
destroy .s1 .s2 .s3 .s4
|
|
} \
|
|
-result {1.0 1.0 1.0 1.0}
|
|
|
|
test scale-20.1 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 1} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
} -body {
|
|
scale .s -from 1 -to 50 -command {set commandedVar}
|
|
pack .s
|
|
update ; # -command callback shall NOT fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {1 -1}
|
|
test scale-20.2 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 2} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
set scaleVar 7
|
|
} -body {
|
|
scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
|
|
pack .s
|
|
update ; # -command callback shall NOT fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {7 -1}
|
|
test scale-20.3 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 3} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
} -body {
|
|
scale .s -from 1 -to 50
|
|
.s set 10
|
|
.s configure -command {set commandedVar}
|
|
pack .s
|
|
update ; # -command callback shall NOT fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {10 -1}
|
|
test scale-20.4 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 4} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
} -body {
|
|
scale .s -from 1 -to 50 -command {set commandedVar}
|
|
pack .s
|
|
update idletasks
|
|
.s set 10
|
|
set timeout [after 500 {set $commandedVar "timeout"}]
|
|
set commandedVar -1
|
|
vwait commandedVar ; # -command callback shall fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
after cancel $timeout
|
|
destroy .s
|
|
} -result {10 10}
|
|
test scale-20.5 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 5} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
} -body {
|
|
scale .s -from 1 -to 50
|
|
pack .s
|
|
update idletasks
|
|
.s set 10
|
|
.s configure -command {set commandedVar}
|
|
update ; # -command callback shall NOT fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {10 -1}
|
|
test scale-20.6 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 6} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
} -body {
|
|
scale .s -from 1 -to 50
|
|
pack .s
|
|
update idletasks
|
|
.s configure -command {set commandedVar}
|
|
.s set 10
|
|
set timeout [after 500 {set $commandedVar "timeout"}]
|
|
vwait commandedVar ; # -command callback shall fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
after cancel $timeout
|
|
} -result {10 10}
|
|
test scale-20.7 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 7} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
} -body {
|
|
scale .s -from 1 -to 50 -command {set commandedVar}
|
|
pack .s
|
|
update idletasks
|
|
.s set 10
|
|
set timeout [after 500 {set $commandedVar "timeout"}]
|
|
vwait commandedVar ; # -command callback shall fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
after cancel $timeout
|
|
} -result {10 10}
|
|
test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command callback, case 8} -setup {
|
|
catch {destroy .s}
|
|
set res {}
|
|
set commandedVar -1
|
|
set scaleVar 7
|
|
} -body {
|
|
scale .s -from 1 -to 50 -variable scaleVar -command {set commandedVar}
|
|
pack .s
|
|
update idletasks
|
|
.s set 10
|
|
set timeout [after 500 {set $commandedVar "timeout"}]
|
|
vwait commandedVar ; # -command callback shall fire
|
|
set res [list [.s get] $commandedVar]
|
|
} -cleanup {
|
|
destroy .s
|
|
after cancel $timeout
|
|
} -result {10 10}
|
|
|
|
test scale-21.1 {Bug [55b95f578a] - Associating variable with bignum value with scale crashes it} -setup {
|
|
catch {destroy .s}
|
|
} -body {
|
|
pack [scale .s]
|
|
set foo 5.79e99
|
|
# non-regression test for bug [55b95f578a] - shall just not crash
|
|
.s configure -variable foo
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {}
|
|
test scale-21.2 {Bug [55b95f578a] again - Bignum value for -from/-to with scale crashes it} -setup {
|
|
catch {destroy .s}
|
|
} -body {
|
|
pack [scale .s]
|
|
# non-regression test for bug [55b95f578a] - shall just not crash
|
|
.s configure -from -6.8e99 -to 8.8e99
|
|
} -cleanup {
|
|
destroy .s
|
|
} -result {}
|
|
|
|
test scale-22.1 {Bug [5d991b822e]} {
|
|
# Want this not to crash
|
|
set var INIT
|
|
scale .b -variable var
|
|
trace add variable var unset {apply {args {
|
|
.b configure -variable {}
|
|
}}}
|
|
pack .b
|
|
bind .b <Configure> {unset var}
|
|
update
|
|
destroy .b
|
|
} {}
|
|
test scale-22.2 {Bug [5d991b822e]} {
|
|
# Want this not to leak traces
|
|
set var INIT
|
|
scale .b -variable var
|
|
trace add variable var unset {apply {args {
|
|
.b configure -variable new
|
|
}}}
|
|
pack .b
|
|
bind .b <Configure> {unset -nocomplain var}
|
|
update
|
|
destroy .b
|
|
unset new
|
|
} {}
|
|
|
|
option clear
|
|
|
|
# cleanup
|
|
cleanupTests
|
|
return
|