* tests/canvas.test: added canvas-14.[1-6]

	* generic/tkCanvas.c (CanvasWidgetCmd): corrected handling of
	'scan' subcommand args.  Also removed early return cases to goto
	done instead where the canvasPtr would be Tcl_Release'd.  This may
	solve other problems with unreleased canvasPtr's. [Bug #581560]

2 files changed, 44 insertions, 19 deletions

diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c
index 5b7d92c..37f9683 100644
--- a/generic/tkCanvas.c
+++ b/generic/tkCanvas.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkCanvas.c,v 1.18 2002/01/25 21:09:36 dgp Exp $
+ * RCS: @(#) $Id: tkCanvas.c,v 1.19 2002/07/24 19:41:38 hobbs Exp $
  */
 
 /* #define USE_OLD_TAG_SEARCH 1 */
@@ -1388,7 +1388,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
       case CANV_ITEMCGET: {
 	if (argc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
-	    return TCL_ERROR;
+	    result = TCL_ERROR;
+	    goto done;
 	}
 #ifdef USE_OLD_TAG_SEARCH
 	itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
@@ -1623,26 +1624,22 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
 	    "mark", "dragto", NULL
 	};
 
-	if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "scan option", 0,
-		&index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-
-	if ((argc != 5) && (argc != 5+index)) {
+	if (argc < 5) {
+	    Tcl_WrongNumArgs(interp, 2, argv, "mark|dragto x y ?dragGain?");
+	    result = TCL_ERROR;
+	} else if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings,
+		"scan option", 0, &index) != TCL_OK) {
+	    result = TCL_ERROR;
+	} else if ((argc != 5) && (argc != 5+index)) {
 	    Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
 	    result = TCL_ERROR;
-	    goto done;
-	}
-	if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
+	} else if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
 		|| (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
 	    result = TCL_ERROR;
-	    goto done;
-	}
-	if ((argc == 6) && (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
+	} else if ((argc == 6) &&
+		(Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
 	    result = TCL_ERROR;
-            goto done;
-	}
-	if (!index) {
+	} else if (!index) {
 	    canvasPtr->scanX = x;
 	    canvasPtr->scanXOrigin = canvasPtr->xOrigin;
 	    canvasPtr->scanY = y;
@@ -1717,7 +1714,8 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
 	}
 	if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "select option", 0,
 		&optionindex) != TCL_OK) {
-	    return TCL_ERROR;
+	    result = TCL_ERROR;
+	    goto done;
 	}
 	switch ((enum options) optionindex) {
 	  case CANV_ADJUST: {
diff --git a/tests/canvas.test b/tests/canvas.test
index 84e7c62..d8df53a 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-2000 Ajuba Solutions.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvas.test,v 1.14 2002/07/14 05:48:46 dgp Exp $
+# RCS: @(#) $Id: canvas.test,v 1.15 2002/07/24 19:41:38 hobbs Exp $
 
 package require tcltest 2.1
 namespace import -force tcltest::configure
@@ -427,6 +427,33 @@ test canvas-13.1 {canvas delete during event, SF bug-228024} {
     set ::x
 } okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok
 
+test canvas-14.1 {canvas scan SF bug 581560} {
+    destroy .c; canvas .c
+    list [catch {.c scan} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.2 {canvas scan} {
+    destroy .c; canvas .c
+    list [catch {.c scan bogus} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.3 {canvas scan} {
+    destroy .c; canvas .c
+    list [catch {.c scan mark} msg] $msg
+} {1 {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"}}
+test canvas-14.4 {canvas scan} {
+    destroy .c; canvas .c
+    list [catch {.c scan mark 10 10} msg] $msg
+} {0 {}}
+test canvas-14.5 {canvas scan} {
+    destroy .c; canvas .c
+    list [catch {.c scan mark 10 10 5} msg] $msg
+} {1 {wrong # args: should be ".c scan mark x y"}}
+test canvas-14.6 {canvas scan} {
+    destroy .c; canvas .c
+    list [catch {.c scan dragto 10 10 5} msg] $msg
+} {0 {}}
+
+destroy .c
+
 # cleanup
 ::tcltest::cleanupTests
 return