summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/canvas.test36
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 ""
+} {}