Added performance improvement to canvas tag manipulation. This was

a submitted patch.

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 ""
+} {}