diff options
| -rw-r--r-- | generic/tclParse.c | 12 | ||||
| -rw-r--r-- | tests/encoding.test | 4 | ||||
| -rw-r--r-- | tests/parseOld.test | 11 |
3 files changed, 16 insertions, 11 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c index 4f35468..e465ad7 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.7 1999/05/04 01:32:12 stanton Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.8 1999/07/02 06:41:23 welch Exp $ */ #include "tclInt.h" @@ -1592,6 +1592,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) unsigned char c; int varIndex, offset; Tcl_UniChar ch; + unsigned array; if (numBytes >= 0) { end = string + numBytes; @@ -1698,12 +1699,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) } break; } + + /* + * Support for empty array names here. + */ + array = ((src != end) && (*src == '(')); tokenPtr->size = src - tokenPtr->start; - if (tokenPtr->size == 0) { + if (tokenPtr->size == 0 && !array) { goto justADollarSign; } parsePtr->numTokens++; - if ((src != end) && (*src == '(')) { + if (array) { /* * This is a reference to an array element. Call * ParseTokens recursively to parse the element name, diff --git a/tests/encoding.test b/tests/encoding.test index 0425f5b..9d79603 100644 --- a/tests/encoding.test +++ b/tests/encoding.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: encoding.test,v 1.4 1999/07/01 17:36:17 jenn Exp $ +# RCS: @(#) $Id: encoding.test,v 1.5 1999/07/02 06:41:29 welch Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -263,7 +263,7 @@ test encoding-12.5 {LoadTableEncoding: symbol encoding} { test encoding-13.1 {LoadEscapeTable} { set x [encoding convertto iso2022 ab\u4e4e\u68d9g] -} "\x1b(Bab\x1b$@8C\x1b$(DD%\x1b(Bg" +} "\x1b(Bab\x1b$@8C\x1b$\(DD%\x1b(Bg" test encoding-14.1 {BinaryProc} { encoding convertto identity \x12\x34\x56\xff\x69 diff --git a/tests/parseOld.test b/tests/parseOld.test index 6f63e7d..746e3e3 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -1,4 +1,4 @@ -# Commands covered: set (plus basic command syntax). Also tests the +\\\\\# Commands covered: set (plus basic command syntax). Also tests the # procedures in the file tclOldParse.c. This set of tests is an old # one that predates the new parser in Tcl 8.1. # @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseOld.test,v 1.4 1999/06/26 20:55:08 rjohnson Exp $ +# RCS: @(#) $Id: parseOld.test,v 1.5 1999/07/02 06:41:29 welch Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -185,10 +185,9 @@ test parseOld-5.11 {array variable substitution} { set b a$! set b } {a$!} -test parseOld-5.12 {array variable substitution} { - set b a$() - set b -} {a$()} +test parseOld-5.12 {empty array name support} { + list [catch {set b a$()} msg] $msg +} {1 {can't read "()": no such variable}} catch {unset a} test parseOld-5.13 {array variable substitution} { catch {unset a} |