diff options
| -rw-r--r-- | ChangeLog | 18 | ||||
| -rw-r--r-- | doc/GetIndex.3 | 6 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 11 | ||||
| -rw-r--r-- | tests/binary.test | 7 | ||||
| -rw-r--r-- | tests/winDde.test | 17 |
5 files changed, 54 insertions, 5 deletions
@@ -1,3 +1,21 @@ +1999-06-28 <redman@scriptics.com> + + * generic/tclIndexObj.c: + * doc/GetIndex.3: + * tests/binary.test: + * tests/winDde.test: Applied patch from Peter Hardie (with + changes) to fix problem with Tcl_GetIndexFromObj() when the key + being passed is the empty string. It used to match "" and return + TCL_OK, but it should have returned TCL_ERROR instead. Added test + case to "binary" and "dde" commands to check the behavior. Added + documentation note as well. + +1999-06-26 <redman@scriptics.com> + + * win/tclWinDde.c: Applied patch from Peter Hardie to add poke + command to dde. Also rev'd version of dde package to 1.1. + [Bug: 1738] + 1999-06-25 <stanton@scriptics.com> * tests/reg.test: diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 342069a..8ba28ba 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetIndex.3,v 1.3 1999/04/16 00:46:31 stanton Exp $ +'\" RCS: @(#) $Id: GetIndex.3,v 1.4 1999/06/28 23:49:31 redman Exp $ '\" .so man.macros .TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures" @@ -81,7 +81,9 @@ arguments (e.g. during a reinvocation of a Tcl command), it returns the matching index immediately without having to redo the lookup operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries in \fItablePtr\fR are static: they must not change between -invocations. +invocations. If the value of \fIobjPtr\fR is the empty string, +\fTcl_GetIndexFromObj\fR will treat it as a non-matching value +and return TCL_ERROR. .VS .PP \fBTcl_GetIndexFromObjStruct\fR works just like diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 5acb6c5..eedb259 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIndexObj.c,v 1.3 1999/04/16 00:46:47 stanton Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.4 1999/06/28 23:49:31 redman Exp $ */ #include "tclInt.h" @@ -173,6 +173,15 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, key = Tcl_GetStringFromObj(objPtr, &length); index = -1; numAbbrev = 0; + + /* + * The key should not be empty, otherwise it's not a match. + */ + + if (key[0] == '\0') { + goto error; + } + for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr = (char **) ((long) entryPtr + offset), i++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { diff --git a/tests/binary.test b/tests/binary.test index c890f4e..a44da4d 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.5 1999/06/26 03:54:10 jenn Exp $ +# RCS: @(#) $Id: binary.test,v 1.6 1999/06/28 23:49:31 redman Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1456,6 +1456,11 @@ test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} { list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } {2 1 1.6} +test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} { + catch {binary ""} result + set result +} {bad option "": must be format or scan} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/winDde.test b/tests/winDde.test index b734f82..67c9c83 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winDde.test,v 1.5 1999/06/28 18:23:21 redman Exp $ +# RCS: @(#) $Id: winDde.test,v 1.6 1999/06/28 23:49:32 redman Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -145,6 +145,21 @@ test winDde-4.4 {DDE eval locally} {pcOnly} { set a } foo +test winDde-5.1 {check for bad arguments} {} { + catch {dde execute "" "" "" ""} result + set result +} {wrong # args: should be "dde execute ?-async? serviceName topicName value"} + +test winDde-5.2 {check for bad arguments} {} { + catch {dde execute "" "" ""} result + set result +} {cannot execute null data} + +test winDde-5.3 {check for bad arguments} {} { + catch {dde execute -foo "" "" ""} result + set result +} {wrong # args: should be "dde execute ?-async? serviceName topicName value"} + #cleanup file delete -force $::scriptName |