summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2002-07-24 19:41:38 (GMT)
committerhobbs <hobbs>2002-07-24 19:41:38 (GMT)
commit258a9aa3872b8f0556f1cc7802f996e9f340a69d (patch)
treef644f0080bd787e86516f776d01d009597b46a0e
parentd25a5da28b653367b692c8dff3e157acfc03d65f (diff)
downloadtk-258a9aa3872b8f0556f1cc7802f996e9f340a69d.zip
tk-258a9aa3872b8f0556f1cc7802f996e9f340a69d.tar.gz
tk-258a9aa3872b8f0556f1cc7802f996e9f340a69d.tar.bz2
* 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]
-rw-r--r--generic/tkCanvas.c34
-rw-r--r--tests/canvas.test29
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