diff options
| -rw-r--r-- | generic/tkCanvas.c | 34 | ||||
| -rw-r--r-- | tests/canvas.test | 29 |
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 |