From 39f2c1f37b1527a798cabde7ec007c600a9b8a0a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 17 Sep 2003 23:45:35 +0000
Subject:         * generic/tkImage.c:    Stopped [image create] from
 generating an         * tests/image.test:     image command name that would
 overwrite an         existing command name.  Thanks to Michael Schlenker. 
 [Bug 808039].

---
 ChangeLog         |  6 ++++++
 generic/tkImage.c | 11 +++++++----
 tests/image.test  | 14 +++++++++++++-
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5e7a758..eaa8e47 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-09-17  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tkImage.c:	Stopped [image create] from generating an
+	* tests/image.test:	image command name that would overwrite an
+	existing command name.  Thanks to Michael Schlenker.  [Bug 808039].
+
 2003-09-16  Peter Spjuth  <peter.spjuth@space.se>
 	* tests/grid.test:
 	* generic/tkGrid.c: Reworked a part of grid's geometry computations
diff --git a/generic/tkImage.c b/generic/tkImage.c
index a27a446..476662b 100644
--- a/generic/tkImage.c
+++ b/generic/tkImage.c
@@ -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: tkImage.c,v 1.21 2003/07/07 09:35:58 dkf Exp $
+ * RCS: @(#) $Id: tkImage.c,v 1.22 2003/09/17 23:45:35 dgp Exp $
  */
 
 #include "tkInt.h"
@@ -233,9 +233,12 @@ Tk_ImageObjCmd(clientData, interp, objc, objv)
 	     */
 
 	    if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) {
-		dispPtr->imageId++;
-		sprintf(idString, "image%d", dispPtr->imageId);
-		name = idString;
+                Tcl_CmdInfo dummy;
+                do {
+		    dispPtr->imageId++;
+		    sprintf(idString, "image%d", dispPtr->imageId);
+		    name = idString;
+                } while (Tcl_GetCommandInfo(interp, name, &dummy) != 0);
 		firstOption = 3;
 	    } else {
 		TkWindow *topWin;
diff --git a/tests/image.test b/tests/image.test
index 7199fc9..d318713 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: image.test,v 1.10 2003/05/08 09:35:41 dkf Exp $
+# RCS: @(#) $Id: image.test,v 1.11 2003/09/17 23:45:35 dgp Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -86,6 +86,18 @@ test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main w
     removeFile script
     set x
 } {0 {1 {images may not be named the same as the main window}}}
+test image-1.11 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup {
+    set i [image create bitmap]
+    regexp {^image(\d+)$} $i -> serial
+    incr serial
+    proc image$serial {} {return works}
+    set j [image create bitmap]
+} -body {
+    image$serial
+} -cleanup {
+    rename image$serial {}
+    image delete $i $j
+} -result works
 
 test image-2.1 {Tk_ImageCmd procedure, "delete" option} {
     list [catch {image delete} msg] $msg
-- 
cgit v0.12