From a721d2a2fbcf2cacf3b6fffd2b4c09aaf5b83350 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 5 Apr 2006 12:48:25 +0000 Subject: Nail [Bug 1464039] by allowing the empty string to be exactly matched by Tcl_GetIndexFromObj. Also added tests. --- ChangeLog | 50 +++++++++++++++++++++++++++----------------------- generic/tclIndexObj.c | 34 +++++++++++++++------------------- tests/indexObj.test | 18 +++++++++++++++++- 3 files changed, 59 insertions(+), 43 deletions(-) diff --git a/ChangeLog b/ChangeLog index 88f8e85..f4cbca3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,29 +1,33 @@ +2006-04-05 Donal K. Fellows + + * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Allow empty + strings to be matched by the Tcl_GetIndexFromObj machinery, but only + ever exactly. [Bug 1464039] + 2006-04-03 Andreas Kupries - * generic/tclIO.c (ReadChars): Added check and panic and - commentary to a piece of code which relies on BUFFER_PADDING to - create enough space at the beginning of each buffer for the - insertion of partial multi-byte data at the beginning of a - buffer. To explain why this code is ok, and as precaution if - someone twiddled the BUFFER_PADDING into uselessness. - - * generic/tclIO.c (ReadChars): [SF Tcl Bug 1462248]. Added code to - temporarily suppress the use of TCL_ENCODING_END set when eof - was reached while the buffer we are converting is not truly the - last buffer in the queue. Together with the Utf bug below it was - possible to completely bollox the buffer data structures, - eventually crashing Tcl. - - * generic/tclEncoding.c (UtfToUtfProc): Fixed problem where the - function accessed memory beyond the end of the input - buffer. When TCL_ENCODING_END is set and the last bytes of the - buffer start a multi-byte sequence. This bug contributed to [SF - Tcl Bug 1462248]. + * generic/tclIO.c (ReadChars): Added check, panic and commentary to + piece of code which relies on BUFFER_PADDING to create enough space at + the beginning of each buffer for the insertion of partial multibyte + data at the beginning of a buffer. Commentary explains why this code + is OK, and the panic is as a precaution if someone twiddled the + BUFFER_PADDING into uselessness. + + * generic/tclIO.c (ReadChars): [Bug 1462248]. Temporarily suppress + the use of TCL_ENCODING_END set when EOF was reached while the buffer + we are converting is not truly the last buffer in the queue. Together + with the Utf bug below it was possible to completely wreck the buffer + data structures, eventually crashing Tcl. + + * generic/tclEncoding.c (UtfToUtfProc): Stop accessing memory beyond + the end of the input buffer when TCL_ENCODING_END is set and the last + bytes of the buffer start a multi-byte sequence. This bug contributed + to [Bug 1462248]. 2006-03-30 Miguel Sofer * generic/tclExecute.c: remove unused var and silence gcc warning - + 2006-03-29 Jeff Hobbs * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\" @@ -53,7 +57,7 @@ * macosx/Tcl.xcode/default.pbxuser: add '-singleproc 1' cli arg to * macosx/Tcl.xcodeproj/default.pbxuser: tcltest to ease test debugging. - + * macosx/Tcl.xcode/project.pbxproj: removed $prefix/share from * macosx/Tcl.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change to unix/configure.in of 2006-03-13. @@ -1016,8 +1020,8 @@ 2005-11-18 Andreas Kupries * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' patch - for [SF Tcl Bug 1359094]. This moves the retrieval of the next channel - state to the end of the loop, as the called closeproc may close other + for [Bug 1359094]. This moves the retrieval of the next channel state + to the end of the loop, as the called closeproc may close other channels, i.e. modify the list we are iterating, invalidating any pointer retrieved earlier. diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index c9f8e1d..bdd291c 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.28 2006/02/16 20:25:07 dgp Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.29 2006/04/05 12:48:25 dkf Exp $ */ #include "tclInt.h" @@ -165,7 +165,7 @@ Tcl_GetIndexFromObjStruct( int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { - int index, length, i, numAbbrev; + int index, idx, numAbbrev; char *key, *p1; CONST char *p2; CONST char * CONST *entryPtr; @@ -185,34 +185,26 @@ Tcl_GetIndexFromObjStruct( } /* - * Lookup the value of the object in the table. Accept unique + * Lookup the value of the object in the table. Accept unique * abbreviations unless TCL_EXACT is set in flags. */ - key = Tcl_GetStringFromObj(objPtr, &length); + key = TclGetString(objPtr); index = -1; numAbbrev = 0; /* - * The key should not be empty, otherwise it's not a match. - */ - - if (key[0] == '\0') { - goto error; - } - - /* * Scan the table looking for one of: * - An exact match (always preferred) * - A single abbreviation (allowed depending on flags) * - Several abbreviations (never allowed, but overridden by exact match) */ - for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), i++) { + for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; + entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { - index = i; + index = idx; goto done; } } @@ -226,15 +218,19 @@ Tcl_GetIndexFromObjStruct( */ numAbbrev++; - index = i; + index = idx; } } /* - * Check if we were instructed to disallow abbreviations. + * Check if we were instructed to disallow abbreviations. Note that we do + * not allow the empty string as an abbreviation of anything; it is only + * processed by this function as a non-error case if the table of strings + * has an entry in it that is itself an empty string. This only matters in + * the case where the table has a singleton entry. */ - if ((flags & TCL_EXACT) || (numAbbrev != 1)) { + if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) { goto error; } @@ -270,7 +266,7 @@ Tcl_GetIndexFromObjStruct( TclNewObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); - Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) && + Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) && !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key, "\": must be ", STRING_AT(tablePtr, offset, 0), NULL); for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; diff --git a/tests/indexObj.test b/tests/indexObj.test index ca58cc3..6df9082 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: indexObj.test,v 1.10 2006/02/16 20:25:07 dgp Exp $ +# RCS: @(#) $Id: indexObj.test,v 1.11 2006/04/05 12:48:26 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -38,6 +38,12 @@ test indexObj-1.6 {forced exact match} testindexobj { test indexObj-1.7 {forced exact match} testindexobj { testindexobj 1 0 x abc def xalb xyz alm x } {5} +test indexObj-1.8 {exact match of empty values} testindexobj { + testindexobj 1 1 {} a aa aaa {} b bb bbb +} 3 +test indexObj-1.9 {exact match of empty values} testindexobj { + testindexobj 1 0 {} a aa aaa {} b bb bbb +} 3 test indexObj-2.1 {no match} testindexobj { list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg @@ -57,6 +63,12 @@ test indexObj-2.5 {omit error message} testindexobj { test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} { list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg } {1 {bad token "d": must be dumb, daughter, a, or c}} +test indexObj-2.7 {exact match of empty values} testindexobj { + list [catch {testindexobj 1 1 {} a b c} msg] $msg +} {1 {bad token "": must be a, b, or c}} +test indexObj-2.8 {exact match of empty values: singleton case} testindexobj { + list [catch {testindexobj 1 1 {} a} msg] $msg +} {1 {bad token "": must be a}} test indexObj-3.1 {cache result to skip next lookup} testindexobj { testindexobj check 42 @@ -114,3 +126,7 @@ test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj { # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12