summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog18
-rw-r--r--doc/GetIndex.36
-rw-r--r--generic/tclIndexObj.c11
-rw-r--r--tests/binary.test7
-rw-r--r--tests/winDde.test17
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