From b7e8369091ba30a1598b6b2c9bf440a007baced3 Mon Sep 17 00:00:00 2001
From: welch <welch>
Date: Fri, 2 Jul 1999 06:41:23 +0000
Subject: Improved support for empty array names

---
 generic/tclParse.c  | 12 +++++++++---
 tests/encoding.test |  4 ++--
 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}
-- 
cgit v0.12