scale.test

来自「linux系统下的音频通信」· TEST 代码 · 共 802 行 · 第 1/2 页

# 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.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) scale.test 1.28 97/07/31 10:20:43

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# 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 orientation "badValue": must be vertical or horizontal}}
    {-orient horizontal horizontal {} {}}
    {-relief ridge ridge badValue {bad relief type "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 type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state disabled disabled badValue
	    {bad state value "badValue": must be normal, active, or disabled}}
    {-state normal 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] 5]
} {33 {-borderwidth borderWidth BorderWidth 2 2}}
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 {bad option "c": must be cget, configure, coords, get, identify, or set}}
test scale-3.31 {ScaleWidgetCmd procedure} {
    list [catch {.s co} msg] $msg
} {1 {bad 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 orientation "dumb": must be vertical or horizontal}}
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 value "bogus": must be normal, active, or disabled}}

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
    .s get
} {5.0e+09}
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
    .s get
} {6.0e-06}
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
    .s get
} {6.0e-06}
test scale-6.16 {ComputeFormat procedure} {
    .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
    .s set .00006
    .s get
} {6e-05}
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} {fonts} {
    catch {destroy .s}