diff options
Diffstat (limited to 'tests/scrollbar.test')
| -rw-r--r-- | tests/scrollbar.test | 79 |
1 files changed, 34 insertions, 45 deletions
diff --git a/tests/scrollbar.test b/tests/scrollbar.test index fe10d5b..061eacc 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -2,9 +2,9 @@ # the "scrollbar" 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-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -75,16 +75,16 @@ foreach test { {bad relief "non-existent": must be flat, groove, raised, ridge, solid, or sunken}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} + {-bd 4 4 badValue {expected screen distance but got "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} + {-borderwidth 1.3 1 badValue {expected screen distance but got "badValue"}} {-command "set x" {set x} {} {}} - {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}} + {-elementborderwidth 4 4 badValue {expected screen distance but got "badValue"}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} + {-highlightthickness 6 6 bogus {expected screen distance but got "bogus"}} {-highlightthickness -2 0 {} {}} {-jump true 1 silly {expected boolean value but got "silly"}} {-orient horizontal horizontal badValue @@ -95,7 +95,7 @@ foreach test { {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}} {-takefocus "any string" "any string" {} {}} {-troughcolor #432 #432 lousy {unknown color name "lousy"}} - {-width 32 32 badValue {bad screen distance "badValue"}} + {-width 32 32 badValue {expected screen distance but got "badValue"}} } { lassign $test name value okResult badValue badResult # Assume $name is plain; true of all our in-use options! @@ -316,7 +316,7 @@ destroy .t test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { list [catch {.s get a} msg] $msg } {1 {wrong # args: should be ".s get"}} -test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} { +test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} {deprecated needsTcl87} { .s set 100 10 13 14 .s get } {100 10 13 14} @@ -401,36 +401,36 @@ test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} { } set result } {0.4 0.4} -test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { list [catch {.s set abc def ghi jkl} msg] $msg } {1 {expected integer but got "abc"}} -test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { list [catch {.s set 1 def ghi jkl} msg] $msg } {1 {expected integer but got "def"}} -test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { list [catch {.s set 1 2 ghi jkl} msg] $msg } {1 {expected integer but got "ghi"}} -test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { list [catch {.s set 1 2 3 jkl} msg] $msg } {1 {expected integer but got "jkl"}} -test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { .s set -10 50 20 30 .s get } {0 50 0 0} -test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { .s set 100 -10 20 30 .s get } {100 0 20 30} -test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} {deprecated needsTcl87} { .s set 100 50 30 20 .s get } {100 50 30 30} test scrollbar-3.71 {ScrollbarWidgetCmd procedure, "set" option} { list [catch {.s set 1 2 3} msg] $msg -} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} +} {1 {wrong # args: should be ".s set firstFraction lastFraction"}} test scrollbar-3.72 {ScrollbarWidgetCmd procedure, "set" option} { list [catch {.s set 1 2 3 4 5} msg] $msg -} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}} +} {1 {wrong # args: should be ".s set firstFraction lastFraction"}} test scrollbar-3.73 {ScrollbarWidgetCmd procedure} { list [catch {.s bogus} msg] $msg } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}} @@ -657,7 +657,7 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} notAqua { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 + event generate .t.f.s <Button> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -678,7 +678,7 @@ test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} notAqua { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 + event generate .t.f.s <Button> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t.f <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -697,7 +697,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.1 {<MouseWheel> event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -705,28 +705,15 @@ test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} - pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left update focus -force .s + event generate .s <Enter> event generate .s <MouseWheel> -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s -} -result {5.0} -test scrollbar-10.1.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -yscrollcommand {.s set}] -side left - for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} - pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left - update - focus -force .s - event generate .s <MouseWheel> -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {5.0} +} -result {4.0} -test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2 {<MouseWheel> event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -734,13 +721,14 @@ test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} - pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s + event generate .s <Enter> event generate .s <Shift-MouseWheel> -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s -} -result {1.4} -test scrollbar-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup { +} -result {1.3} +test scrollbar-10.3 {<MouseWheel> event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -748,12 +736,13 @@ test scrollbar-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -set pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s - event generate .s <Shift-MouseWheel> -delta -4 + event generate .s <Enter> + event generate .s <MouseWheel> -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s -} -result {1.4} +} -result {1.3} test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body { proc destroy_scrollbar {} { @@ -763,11 +752,11 @@ test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destructi } toplevel .top scrollbar .top.s - bind .top.s <2> {destroy_scrollbar} + bind .top.s <Button-2> {destroy_scrollbar} pack .top.s focus -force .top.s update - event generate .top.s <2> + event generate .top.s <Button-2> update ; # shall not trigger error invalid command name ".top.s" } -cleanup { destroy .top.s .top @@ -782,11 +771,11 @@ test scrollbar-11.2 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destructi wm minsize .top 50 400 update scrollbar .top.s - bind .top.s <2> {after idle destroy_scrollbar} + bind .top.s <Button-2> {after idle destroy_scrollbar} pack .top.s -expand true -fill y focus -force .top.s update - event generate .top.s <2> -x 2 -y [expr {[winfo height .top.s] / 2}] + event generate .top.s <Button-2> -x 2 -y [expr {[winfo height .top.s] / 2}] update ; # shall not trigger error invalid command name ".top.s" } -cleanup { destroy .top.s .top |