diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/bind.test | 27 | ||||
| -rw-r--r-- | tests/canvText.test | 3 | ||||
| -rw-r--r-- | tests/canvas.test | 36 | ||||
| -rw-r--r-- | tests/scale.test | 4 | ||||
| -rw-r--r-- | tests/winClipboard.test | 5 |
5 files changed, 68 insertions, 7 deletions
diff --git a/tests/bind.test b/tests/bind.test index 74a0877..581abac 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -4,11 +4,12 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: bind.test,v 1.1.4.2 1998/09/30 02:18:24 stanton Exp $ +# RCS: @(#) $Id: bind.test,v 1.1.4.3 1998/11/25 21:16:39 stanton Exp $ if {[string compare test [info procs test]] != 0} { source defs @@ -2134,7 +2135,7 @@ foreach check { {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} - {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}} + {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}} } { set event [lindex $check 0] test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" { @@ -2544,5 +2545,27 @@ test bind-30.2 {Tk_BackgroundError procedure} { (command bound to event)}} rename bgerror {} +test bind-31.1 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x Wheel} + event gen .b.f <MouseWheel> + set x +} {Wheel} +test bind-31.2 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x %D} + event gen .b.f <MouseWheel> -delta 120 + set x +} {120} +test bind-31.2 {MouseWheel events} { + setup + set x {} + bind .b.f <MouseWheel> {set x "%D %x %y"} + event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 + set x +} {240 10 30} + destroy .b diff --git a/tests/canvText.test b/tests/canvText.test index b0879b1..3de8813 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: canvText.test,v 1.1.4.2 1998/09/30 02:18:30 stanton Exp $ +# RCS: @(#) $Id: canvText.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {"[info procs test]" != "test"} { source defs @@ -34,6 +34,7 @@ set ax [font measure $font 0] foreach test { {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}} {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}} + {-fill {} {} {} {}} {-font {Times 40} {Times 40} {} {font "" doesn't exist}} {-justify left left xyz {bad justification "xyz": must be left, right, or center}} {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} diff --git a/tests/canvas.test b/tests/canvas.test index 79d3d18..5807b52 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -3,11 +3,12 @@ # standard fashion for Tcl tests. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: canvas.test,v 1.1.4.2 1998/09/30 02:18:30 stanton Exp $ +# RCS: @(#) $Id: canvas.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {[info procs test] != "test"} { source defs @@ -211,3 +212,36 @@ test canvas-8.1 {canvas arc bbox} { set pieBox [.c bbox arc3] list $arcBox $coordBox $pieBox } {{48 21 100 94} {248 21 300 94} {398 21 500 112}} +test canvas-9.1 {canvas id creation and deletion} { + # With Tk 8.0.4 the ids are now stored in a hash table. You + # can use this test as a performance test with older versions + # by changing the value of size. + set size 15 + + catch {destroy .c} + set c [canvas .c] + for {set i 0} {$i < $size} {incr i} { + set x [expr {-10 + 3*$i}] + for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { + $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \ + -outline black -fill blue -tags rect + $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \ + -anchor center -tags text + } + } + + # The actual bench mark - this code also exercises all the hash + # table changes. + + set time [lindex [time { + foreach id [$c find withtag all] { + $c lower $id + $c raise $id + $c find withtag $id + $c bind <Return> $id {} + $c delete $id + } + }] 0] + + set x "" +} {} diff --git a/tests/scale.test b/tests/scale.test index 1a172dc..f1b773a 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: scale.test,v 1.1.4.2 1998/09/30 02:18:53 stanton Exp $ +# RCS: @(#) $Id: scale.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $ if {[info procs test] != "test"} { source defs @@ -330,7 +330,7 @@ test scale-6.7 {ComputeFormat procedure} { .s configure -from 1000000000 -to 10000000000 -resolution 1000000000 .s set 4930000000 expr {[.s get] == 5.0e+09} -} {1} +} 1 test scale-6.8 {ComputeFormat procedure} { .s configure -from .1 -to 1 -resolution .1 .s set .6 diff --git a/tests/winClipboard.test b/tests/winClipboard.test index 059232a..b07fcdf 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winClipboard.test,v 1.1.4.1 1998/09/30 02:19:05 stanton Exp $ +# RCS: @(#) $Id: winClipboard.test,v 1.1.4.2 1998/11/25 21:16:40 stanton Exp $ if {$tcl_platform(platform)!="windows"} { return @@ -21,6 +21,9 @@ if {[string compare test [info procs test]] == 1} { source defs } +# Note that these tests may fail if another application is grabbing the +# clipboard (e.g. an X server) + test winClipboard-1.1 {TkSelGetSelection} { clipboard clear catch {selection get -selection CLIPBOARD} msg |