diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/canvas.test | 36 |
1 files changed, 35 insertions, 1 deletions
diff --git a/tests/canvas.test b/tests/canvas.test index 7914668..c37a36a 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.3 1998/09/14 18:23:44 stanton Exp $ +# RCS: @(#) $Id: canvas.test,v 1.4 1998/10/13 18:13:07 rjohnson Exp $ if {[info procs test] != "test"} { source defs @@ -202,3 +203,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 "" +} {} |