summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1999-07-02 06:41:23 (GMT)
committerwelch <welch>1999-07-02 06:41:23 (GMT)
commitb7e8369091ba30a1598b6b2c9bf440a007baced3 (patch)
treecbe0bd27d4413c6dbc5c788f534133a809340def
parent77a4b3e4bb780523b51caec96494323aebc956af (diff)
downloadtcl-b7e8369091ba30a1598b6b2c9bf440a007baced3.zip
tcl-b7e8369091ba30a1598b6b2c9bf440a007baced3.tar.gz
tcl-b7e8369091ba30a1598b6b2c9bf440a007baced3.tar.bz2
Improved support for empty array names
-rw-r--r--generic/tclParse.c12
-rw-r--r--tests/encoding.test4
-rw-r--r--tests/parseOld.test11
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}