Tcl Source Code

Check-in [52073ab224]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:cherrypick 3bcf97f766: array index syntax done. ${...} not yet complete wrt backslashes.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-465
Files: files | file ages | folders
SHA1: 52073ab224971646715839b770fa51fd283644bf
User & Date: avl 2017-03-05 11:22:33
Context
2017-03-05
19:38
Deal with backslashes in ${...}, change "char" to "character" in error, fix tests. check-in: 05efac2985 user: avl tags: tip-465
11:22
cherrypick 3bcf97f766: array index syntax done. ${...} not yet complete wrt backslashes. check-in: 52073ab224 user: avl tags: tip-465
11:04
Create new branch named "tip-465" check-in: 64cf6142f5 user: avl tags: tip-465
2017-03-01
10:03
Implement (9): disallow $arr((() and ${{{} resulting in a consistent version of (4) check-in: 3bcf97f766 user: avl tags: avl-tip-282
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclParse.c.

    91     91       TYPE_SPACE,       TYPE_SPACE,       TYPE_NORMAL,      TYPE_NORMAL,
    92     92       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    93     93       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    94     94       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    95     95       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    96     96       TYPE_SPACE,       TYPE_NORMAL,      TYPE_QUOTE,       TYPE_NORMAL,
    97     97       TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    98         -    TYPE_NORMAL,      TYPE_CLOSE_PAREN, TYPE_NORMAL,      TYPE_NORMAL,
           98  +    TYPE_OPEN_PAREN,  TYPE_CLOSE_PAREN, TYPE_NORMAL,      TYPE_NORMAL,
    99     99       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
   100    100       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
   101    101       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
   102    102       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_COMMAND_END,
   103    103       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
   104    104       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
   105    105       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
................................................................................
  1362   1362       int append)			/* Non-zero means append tokens to existing
  1363   1363   				 * information in parsePtr; zero means ignore
  1364   1364   				 * existing tokens in parsePtr and
  1365   1365   				 * reinitialize it. */
  1366   1366   {
  1367   1367       Tcl_Token *tokenPtr;
  1368   1368       register const char *src;
  1369         -    int varIndex;
         1369  +    int varIndex, braceCount = 0;
  1370   1370       unsigned array;
  1371   1371   
  1372   1372       if ((numBytes == 0) || (start == NULL)) {
  1373   1373   	return TCL_ERROR;
  1374   1374       }
  1375   1375       if (numBytes < 0) {
  1376   1376   	numBytes = strlen(start);
................................................................................
  1415   1415        *	  parentheses is the array element name.
  1416   1416        * 3. The $ sign is followed by something that isn't a letter, digit, or
  1417   1417        *	  underscore: in this case, there is no variable name and the token is
  1418   1418        *	  just "$".
  1419   1419        */
  1420   1420   
  1421   1421       if (*src == '{') {
         1422  +        char ch;
  1422   1423   	src++;
  1423   1424   	numBytes--;
  1424   1425   	tokenPtr->type = TCL_TOKEN_TEXT;
  1425   1426   	tokenPtr->start = src;
  1426   1427   	tokenPtr->numComponents = 0;
  1427   1428   
  1428         -	while (numBytes && (*src != '}')) {
         1429  +	ch = *src;
         1430  +	while (numBytes && (braceCount>0 || ch != '}')) {
         1431  +	    if (ch == '{') { braceCount++; }
         1432  +	    else if (ch == '}') { braceCount--; }
  1429   1433   	    numBytes--;
  1430   1434   	    src++;
         1435  +	    ch= *src;
  1431   1436   	}
  1432   1437   	if (numBytes == 0) {
  1433   1438   	    if (parsePtr->interp != NULL) {
  1434   1439   		Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
  1435   1440   			"missing close-brace for variable name", -1));
  1436   1441   	    }
  1437   1442   	    parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
................................................................................
  1479   1484   	if (array) {
  1480   1485   	    /*
  1481   1486   	     * This is a reference to an array element. Call ParseTokens
  1482   1487   	     * recursively to parse the element name, since it could contain
  1483   1488   	     * any number of substitutions.
  1484   1489   	     */
  1485   1490   
  1486         -	    if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
         1491  +	    if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_BAD_ARRAY_INDEX,
  1487   1492   		    TCL_SUBST_ALL, parsePtr)) {
  1488   1493   		goto error;
  1489   1494   	    }
  1490         -	    if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
         1495  +	    if ((parsePtr->term == src+numBytes)){
  1491   1496   		if (parsePtr->interp != NULL) {
  1492   1497   		    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
  1493   1498   			    "missing )", -1));
  1494   1499   		}
  1495   1500   		parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
  1496   1501   		parsePtr->term = src;
  1497   1502   		parsePtr->incomplete = 1;
         1503  +		goto error;
         1504  +	    } else if ((*parsePtr->term != ')')){
         1505  +		if (parsePtr->interp != NULL) {
         1506  +		    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
         1507  +			    "invalid char in array index", -1));
         1508  +		}
         1509  +		parsePtr->errorType = TCL_PARSE_SYNTAX;
         1510  +		parsePtr->term = src;
  1498   1511   		goto error;
  1499   1512   	    }
  1500   1513   	    src = parsePtr->term + 1;
  1501   1514   	}
  1502   1515       }
  1503   1516       tokenPtr = &parsePtr->tokenPtr[varIndex];
  1504   1517       tokenPtr->size = src - tokenPtr->start;

Changes to generic/tclParse.h.

     7      7   #define TYPE_SPACE		0x1
     8      8   #define TYPE_COMMAND_END	0x2
     9      9   #define TYPE_SUBS		0x4
    10     10   #define TYPE_QUOTE		0x8
    11     11   #define TYPE_CLOSE_PAREN	0x10
    12     12   #define TYPE_CLOSE_BRACK	0x20
    13     13   #define TYPE_BRACE		0x40
           14  +#define TYPE_OPEN_PAREN		0x80
           15  +#define TYPE_BAD_ARRAY_INDEX	(TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE)
    14     16   
    15     17   #define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)]
    16     18   
    17     19   MODULE_SCOPE const char tclCharTypeTable[];