Applied patch from Peter Hardie (with modifications) to fix

Tcl_GetIndexFromObj when the key is "".  Added test cases and
doc note.

5 files changed, 54 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 53ec539..ff84fbe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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