diff options
Diffstat (limited to 'tests/scrollbar.test')
| -rw-r--r-- | tests/scrollbar.test | 253 |
1 files changed, 104 insertions, 149 deletions
diff --git a/tests/scrollbar.test b/tests/scrollbar.test index c410c68..5d4334f 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -8,18 +8,9 @@ # All rights reserved. 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] +eval tcltest::configure $argv tcltest::loadTestedCommands -## testmetrics is a win/mac only test command -## -testConstraint testmetrics [llength [info commands testmetrics]] - -update - proc scroll args { global scrollInfo set scrollInfo $args @@ -91,43 +82,45 @@ foreach test { {-troughcolor #432 #432 lousy {unknown color name "lousy"}} {-width 32 32 badValue {bad screen distance "badValue"}} } { - set name [lindex $test 0] - test scrollbar-1.1 {configuration options} { - .s configure $name [lindex $test 1] - lindex [.s configure $name] 4 - } [lindex $test 2] + lassign $test name value okResult badValue badResult + # Assume $name is plain; true of all our in-use options! + test scrollbar-1.$i {configuration options} \ + ".s configure $name [list $value]; .s cget $name" $okResult incr i - if {[lindex $test 3] != ""} { - test scrollbar-1.2 {configuration options} { - list [catch {.s configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] + if {$badValue ne ""} { + test scrollbar-1.$i {configuration options} \ + -body [list .s configure $name $badValue] \ + -returnCodes error -result $badResult + incr i } .s configure $name [lindex [.s configure $name] 3] - incr i } destroy .s -test scrollbar-2.1 {Tk_ScrollbarCmd procedure} { - list [catch {scrollbar} msg] $msg -} {1 {wrong # args: should be "scrollbar pathName ?options?"}} -test scrollbar-2.2 {Tk_ScrollbarCmd procedure} { - list [catch {scrollbar gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test scrollbar-2.3 {Tk_ScrollbarCmd procedure} { +test scrollbar-2.1 {Tk_ScrollbarCmd procedure} -returnCodes error -body { + scrollbar +} -result {wrong # args: should be "scrollbar pathName ?options?"} +test scrollbar-2.2 {Tk_ScrollbarCmd procedure} -body { + scrollbar gorp +} -returnCodes error -result {bad window path name "gorp"} +test scrollbar-2.3 {Tk_ScrollbarCmd procedure} -setup { scrollbar .s - set x "[winfo class .s] [info command .s]" +} -body { + list [winfo class .s] [info command .s] +} -cleanup { destroy .s - set x -} {Scrollbar .s} +} -result {Scrollbar .s} test scrollbar-2.4 {Tk_ScrollbarCmd procedure} { list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] \ [info command .s] } {1 {unknown option "-gorp"} 0 {}} -test scrollbar-2.5 {Tk_ScrollbarCmd procedure} { - set x [scrollbar .s] +test scrollbar-2.5 {Tk_ScrollbarCmd procedure} -setup { + catch {destroy .s} +} -body { + scrollbar .s +} -cleanup { destroy .s - set x -} {.s} +} -result .s scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2 pack .s -side right -fill y @@ -168,18 +161,24 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} { list [catch {.s cget -orient} msg] $msg } {0 vertical} scrollbar .s2 -test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { - list [catch {.s2 cget -bd} msg] $msg -} {0 0} -test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} { - list [catch {.s2 cget -bd} msg] $msg -} {0 2} -test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { - list [catch {.s2 cget -highlightthickness} msg] $msg -} {0 0} -test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} { - list [catch {.s2 cget -highlightthickness} msg] $msg -} {0 1} +test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} { + expr {[.s2 cget -bd] == [lindex [.s2 configure -bd] 3]} +} 1 +test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { + # empty test; duplicated scrollbar-3.11 +} {} +test scrollbar-3.12.1 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { + # empty test; duplicated scrollbar-3.11 +} {} +test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} { + expr {[.s2 cget -highlightthickness] == [lindex [.s2 configure -highlightthickness] 3]} +} 1 +test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { + # empty test; duplicated scrollbar-3.13 +} {} +test scrollbar-3.14.1 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { + # empty test; duplicated scrollbar-3.13 +} {} destroy .s2 test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} { llength [.s configure] @@ -215,13 +214,13 @@ test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} { list [catch {.s delta 18 xxyz} msg] $msg } {1 {expected integer but got "xxyz"}} test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} { - .s delta 20 0 + format {%.6g} [.s delta 20 0] } {0} test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} { - .s delta 0 20 + format {%.6g} [.s delta 0 20] } [format %.6g [expr 20.0/([getTroughSize .s]-1)]] test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} { - .s delta 0 -20 + format {%.6g} [.s delta 0 -20] } [format %.6g [expr -20.0/([getTroughSize .s]-1)]] test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} { toplevel .t -width 250 -height 100 @@ -229,8 +228,8 @@ test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} { scrollbar .t.s -orient horizontal -borderwidth 2 place .t.s -width 201 update - set result [list [.t.s delta 0 20] \ - [.t.s delta [expr [getTroughSize .t.s] - 1] 0]] + set result [list [format {%.6g} [.t.s delta 0 20]] \ + [format {%.6g} [.t.s delta [expr [getTroughSize .t.s] - 1] 0]]] destroy .t set result } {0 1} @@ -247,32 +246,30 @@ test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} { list [catch {.s fraction 24 bogus} msg] $msg } {1 {expected integer but got "bogus"}} test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} { - .s fraction 0 0 + format {%.6g} [.s fraction 0 0] } {0} test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} { - .s fraction 0 1000 + format {%.6g} [.s fraction 0 1000] } {1} test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { - .s fraction 4 21 + format {%.6g} [.s fraction 4 21] } [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ /([getTroughSize .s] - 1)]] -test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} { - .s fraction 4 179 +test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix { + format {%.6g} [.s fraction 4 179] } {1} test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { - .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]] + format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]] } {1} -test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} { - .s fraction 4 178 +test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix { + format {%.6g} [.s fraction 4 178] } {0.993711} -test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics pcOnly} { - expr [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]] \ +test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} { + expr \ + [format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]]] \ == [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \ / ($height - 1 - [testmetrics cyvscroll .s]*2)]] } 1 -test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} { - .s fraction 4 178 -} {0.97006} toplevel .t -width 250 -height 100 wm geom .t +0+0 @@ -281,7 +278,7 @@ place .t.s -width 201 update test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} { - .t.s fraction 100 0 + format {%.6g} [.t.s fraction 100 0] } {0.5} if {[testConstraint testmetrics]} { place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1] @@ -290,7 +287,7 @@ if {[testConstraint testmetrics]} { } update test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} { - .t.s fraction 100 0 + format {%.6g} [.t.s fraction 100 0] } {0} destroy .t test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { @@ -336,10 +333,7 @@ test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} { test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} { .s identify 5 195 } {arrow2} -test scrollbar-3.55 {ScrollbarWidgetCmd procedure, "identify" option} {macOnly} { - .s identify 5 195 -} {} -test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} { +test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} unix { .s identify 0 0 } {} test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} { @@ -436,22 +430,17 @@ scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2 pack .s -side left -fill y .s set .2 .4 update -test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} { + +test scrollbar-6.1 {ScrollbarPosition procedure} unix { .s identify 8 3 } {} -test scrollbar-6.2 {ScrollbarPosition procedure} {macOnly} { - .s identify 8 3 -} {arrow1} -test scrollbar-6.3 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.3 {ScrollbarPosition procedure} unix { .s identify 8 196 } {} -test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.4 {ScrollbarPosition procedure} unix { .s identify 3 100 } {} -test scrollbar-6.5 {ScrollbarPosition procedure} {macOnly} { - .s identify 3 100 -} {trough2} -test scrollbar-6.6 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.6 {ScrollbarPosition procedure} unix { .s identify 19 100 } {} test scrollbar-6.7 {ScrollbarPosition procedure} { @@ -466,66 +455,56 @@ test scrollbar-6.9 {ScrollbarPosition procedure} { test scrollbar-6.10 {ScrollbarPosition procedure} { .s identify [winfo width .s] [expr [winfo height .s] / 2] } {} - -test scrollbar-6.11 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.11 {ScrollbarPosition procedure} unix { .s identify 8 4 } {arrow1} -test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.12 {ScrollbarPosition procedure} unix { .s identify 8 19 } {arrow1} -test scrollbar-6.13 {ScrollbarPosition procedure} {macOnly} { - .s identify 8 19 -} {trough1} -test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.14 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] / 2] 0 } {arrow1} -test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll .s] - 1] } {arrow1} - -test scrollbar-6.16 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.16 {ScrollbarPosition procedure} unix { .s identify 8 20 } {trough1} -test scrollbar-6.17 {ScrollbarPosition procedure} {macOrUnix nonPortable} { +test scrollbar-6.17 {ScrollbarPosition procedure} {unix nonPortable} { # Don't know why this is non-portable, but it doesn't work on # some platforms. .s identify 8 51 } {trough1} -test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll .s] } {trough1} -test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \ + [testmetrics cyvscroll .s] - 1] } {trough1} - -test scrollbar-6.20 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.20 {ScrollbarPosition procedure} unix { .s identify 8 52 } {slider} -test scrollbar-6.21 {ScrollbarPosition procedure} {macOrUnix nonPortable} { +test scrollbar-6.21 {ScrollbarPosition procedure} {unix nonPortable} { # Don't know why this is non-portable, but it doesn't work on # some platforms. .s identify 8 83 } {slider} -test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] \ [expr int(.2 / [.s delta 0 1] + 0.5) + [testmetrics cyvscroll .s]] } {slider} -test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ - + [testmetrics cyvscroll -s] - 1] + + [testmetrics cyvscroll .s] - 1] } {slider} - -test scrollbar-6.24 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.24 {ScrollbarPosition procedure} unix { .s identify 8 84 } {trough2} -test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.25 {ScrollbarPosition procedure} unix { .s identify 8 179 } {trough2} -test scrollbar-6.26 {ScrollbarPosition procedure} {macOnly} { - .s identify 8 179 -} {arrow2} -test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} { +test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win knownBug} { # This asks for 8,21, which is actually the slider, but there is a # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value # that is larger than the thumb displayed, skewing the ability to @@ -533,41 +512,33 @@ test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ + [testmetrics cyvscroll .s]] } {trough2} -test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll .s] - 1] } {trough2} - -test scrollbar-6.29 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.29 {ScrollbarPosition procedure} unix { .s identify 8 180 } {arrow2} -test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.30 {ScrollbarPosition procedure} unix { .s identify 8 195 } {arrow2} -test scrollbar-6.31 {ScrollbarPosition procedure} {macOnly} { - .s identify 8 195 -} {} -test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll .s]] } {arrow2} -test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.33 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1] } {arrow2} - -test scrollbar-6.34 {ScrollbarPosition procedure} {macOrUnix} { +test scrollbar-6.34 {ScrollbarPosition procedure} unix { .s identify 4 100 } {trough2} -test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.35 {ScrollbarPosition procedure} unix { .s identify 18 100 } {trough2} -test scrollbar-6.36 {ScrollbarPosition procedure} {macOnly} { - .s identify 18 100 -} {} -test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.37 {ScrollbarPosition procedure} win { .s identify 0 100 } {trough2} -test scrollbar-6.38 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.38 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] - 1] 100 } {trough2} @@ -578,29 +549,24 @@ scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2 place .t.s -width 200 .t.s set .2 .4 update -test scrollbar-6.39 {ScrollbarPosition procedure} {macOrUnix} { + +test scrollbar-6.39 {ScrollbarPosition procedure} unix { .t.s identify 4 8 } {arrow1} -test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.40 {ScrollbarPosition procedure} win { .t.s identify 0 [expr [winfo height .t.s] / 2] } {arrow1} -test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.41 {ScrollbarPosition procedure} unix { .t.s identify 82 8 } {slider} -test scrollbar-6.42 {ScrollbarPosition procedure} {macOnly} { - .t.s identify 82 8 -} {} -test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \ - 1] [expr [winfo height .t.s] / 2] } {slider} -test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.44 {ScrollbarPosition procedure} unix { .t.s identify 100 18 } {trough2} -test scrollbar-6.45 {ScrollbarPosition procedure} {macOnly} { - .t.s identify 100 18 -} {} -test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.46 {ScrollbarPosition procedure} win { .t.s identify 100 [expr [winfo height .t.s] - 1] } {trough2} @@ -619,6 +585,7 @@ wm geometry .t +0+0 test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { proc doit {args} { destroy .t.f } proc bgerror {args} {} + destroy .t.f frame .t.f scrollbar .t.f.s -command doit pack .t.f -fill both -expand 1 @@ -637,6 +604,7 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} { proc doit {args} { destroy .t.f.s } proc bgerror {args} {} + destroy .t.f frame .t.f scrollbar .t.f.s -command doit pack .t.f -fill both -expand 1 @@ -668,18 +636,5 @@ catch {destroy .s} catch {destroy .t} # cleanup -::tcltest::cleanupTests +cleanupTests return - - - - - - - - - - - - - |