Diff
Not logged in
Home Timeline Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side Diff

Differences From Artifact [f0b3841222]:

To Artifact [f2b01ea9c5]:

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20













-
+








/*
 * tclCompExpr.c --
 *
 *	This file contains the code to compile Tcl expressions.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Contributions from Don Porter, NIST, 2006.  (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompExpr.c,v 1.48 2007/03/30 17:39:23 dgp Exp $
 * RCS: @(#) $Id: tclCompExpr.c,v 1.49 2007/04/10 14:47:10 dkf Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#undef USE_EXPR_TOKENS
#undef PARSE_DIRECT_EXPR_TOKENS
︙
224
225
226
227
228
229
230
231
232

233
234
235
236
237
238
239

224
225
226
227
228
229
230


231
232
233
234
235
236
237
238








-
-
+








	numBytes = (start ? strlen(start) : 0);
    }

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	msg = Tcl_NewStringObj(
		"not enough memory to parse expression", -1);
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	code = TCL_ERROR;
    } else {
	/*
	 * Initialize the parse tree with the special "START" node.
	 */

	nodes->lexeme = lexeme;
︙
260
261
262
263
264
265
266
267
268


269
270
271
272
273
274
275

259
260
261
262
263
264
265


266
267
268
269
270
271
272
273
274








-
-
+
+









	    do {
		newPtr = (OpNode *) attemptckrealloc((char *) nodes,
			(unsigned int) size * sizeof(OpNode));
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		msg = Tcl_NewStringObj(
			"not enough memory to parse expression", -1);
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		code = TCL_ERROR;
		continue;
	    }
	    nodesAvailable = size;
	    nodes = newPtr;
	}
	nodePtr = nodes + nodesUsed;
︙
351
352
353
354
355
356
357
358
359


360
361
362
363
364
365
366

350
351
352
353
354
355
356


357
358
359
360
361
362
363
364
365








-
-
+
+









	    if (lastWas < 0) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		if (lastStart[0] == '0') {
		    Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
			    start + scanned - lastStart);
		    if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
			post = Tcl_NewStringObj(
				"looks like invalid octal number", -1);
			TclNewLiteralStringObj(post,
				"looks like invalid octal number");
		    }
		    Tcl_DecrRefCount(copy);
		}
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
︙
418
419
420
421
422
423
424
425

426
427
428
429
430
431
432

417
418
419
420
421
422
423

424
425
426
427
428
429
430
431








-
+








		if (code != TCL_OK) {
		    scanned = parsePtr->term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
		if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    msg = Tcl_NewStringObj("invalid character \"$\"", -1);
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    code = TCL_ERROR;
		    continue;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT:
︙
451
452
453
454
455
456
457
458

459
460
461
462
463
464
465

450
451
452
453
454
455
456

457
458
459
460
461
462
463
464








-
+








		    Tcl_FreeParse(&nested);
		    if ((nested.term < end) && (*nested.term == ']')
			    && !nested.incomplete) {
			break;
		    }

		    if (start == end) {
			msg = Tcl_NewStringObj("missing close-bracket", -1);
			TclNewLiteralStringObj(msg, "missing close-bracket");
			parsePtr->term = tokenPtr->start;
			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
			parsePtr->incomplete = 1;
			code = TCL_ERROR;
			break;
		    }
		}
︙
536
537
538
539
540
541
542
543

544
545
546
547
548
549
550

551
552
553
554

555
556
557
558
559
560
561

535
536
537
538
539
540
541

542
543
544
545
546
547
548

549
550
551
552

553
554
555
556
557
558
559
560








-
+






-
+



-
+








		    insertMark = 1;
		    code = TCL_ERROR;
		    continue;
		}

		if (prec[nodePtr[-1].lexeme] > precedence) {
		    if (nodePtr[-1].lexeme == OPEN_PAREN) {
			msg = Tcl_NewStringObj("unbalanced open paren", -1);
			TclNewLiteralStringObj(msg, "unbalanced open paren");
		    } else if (nodePtr[-1].lexeme == COMMA) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    } else if (nodePtr[-1].lexeme == START) {
			msg = Tcl_NewStringObj("empty expression", -1);
			TclNewLiteralStringObj(msg, "empty expression");
		    }
		} else {
		    if (lexeme == CLOSE_PAREN) {
			msg = Tcl_NewStringObj("unbalanced close paren", -1);
			TclNewLiteralStringObj(msg, "unbalanced close paren");
		    } else if ((lexeme == COMMA)
			    && (nodePtr[-1].lexeme == OPEN_PAREN)
			    && (nodePtr[-2].lexeme == FUNCTION)) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
︙
613
614
615
616
617
618
619
620

621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636


637
638
639
640
641
642
643
644

612
613
614
615
616
617
618

619
620
621
622
623
624
625
626
627
628
629
630
631
632
633


634
635

636
637
638
639
640
641
642








-
+














-
-
+
+
-








		/*
		 * We should link the lastWas item to the otherPtr as its
		 * right operand. First make some syntax checks.
		 */

		if ((otherPtr->lexeme == OPEN_PAREN)
			&& (lexeme != CLOSE_PAREN)) {
		    msg = Tcl_NewStringObj("unbalanced open paren", -1);
		    TclNewLiteralStringObj(msg, "unbalanced open paren");
		    code = TCL_ERROR;
		    break;
		}
		if ((otherPtr->lexeme == QUESTION) && ((lastWas < 0)
			|| (nodes[lastWas].lexeme != COLON))) {
		    msg = Tcl_ObjPrintf(
			    "missing operator \":\" at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    code = TCL_ERROR;
		    break;
		}
		if ((lastWas >= 0) && (nodes[lastWas].lexeme == COLON)
			&& (otherPtr->lexeme != QUESTION)) {
		    msg = Tcl_NewStringObj(
			    "unexpected operator \":\" without preceding \"?\"",
		    TclNewLiteralStringObj(msg,
			    "unexpected operator \":\" without preceding \"?\"");
			    -1);
		    code = TCL_ERROR;
		    break;
		}

		/*
		 * Link orphan as right operand of otherPtr.
		 */
︙
667
668
669
670
671
672
673
674

675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692


693
694
695
696
697
698
699
700
701


702
703
704
705
706
707
708
709

665
666
667
668
669
670
671

672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688


689
690

691
692
693
694
695
696


697
698

699
700
701
702
703
704
705








-
+
















-
-
+
+
-






-
-
+
+
-








	    }
	    if (code != TCL_OK) {
		continue;
	    }

	    if (lexeme == CLOSE_PAREN) {
		if (otherPtr->lexeme == START) {
		    msg = Tcl_NewStringObj("unbalanced close paren", -1);
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    code = TCL_ERROR;
		    continue;
		}
		lastWas = OT_NONE;
		lastOpen = otherPtr - nodes;
		otherPtr->left++;

		/*
		 * Create no node for a CLOSE_PAREN lexeme.
		 */

		break;
	    }
	    if (lexeme == COMMA) {
		if  ((otherPtr->lexeme != OPEN_PAREN)
			|| (otherPtr[-1].lexeme != FUNCTION)) {
		    msg = Tcl_NewStringObj(
			    "unexpected \",\" outside function argument list",
		    TclNewLiteralStringObj(msg,
			    "unexpected \",\" outside function argument list");
			    -1);
		    code = TCL_ERROR;
		    continue;
		}
		otherPtr->left++;
	    }
	    if ((lastWas >= 0) && (nodes[lastWas].lexeme == COLON)) {
		msg = Tcl_NewStringObj(
			"unexpected operator \":\" without preceding \"?\"",
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
			-1);
		code = TCL_ERROR;
		continue;
	    }

	    /*
	     * Link orphan as left operand of new node.
	     */
︙
1213
1214
1215
1216
1217
1218
1219
1220
1221


1222
1223
1224
1225
1226
1227
1228

1209
1210
1211
1212
1213
1214
1215


1216
1217
1218
1219
1220
1221
1222
1223
1224








-
-
+
+








	    }
	    do {
		newPtr = (ExprNode *) attemptckrealloc((char *) nodes,
			(unsigned int) size * sizeof(ExprNode));
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		msg = Tcl_NewStringObj(
			"not enough memory to parse expression", -1);
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		code = TCL_ERROR;
		continue;
	    }
	    nodesAvailable = size;
	    if (nodes == NULL) {
		memcpy(newPtr, staticNodes,
			(size_t) nodesUsed * sizeof(ExprNode));
︙
1261
1262
1263
1264
1265
1266
1267

1268
1269
1270
1271
1272
1273
1274

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271








+








		continue;
	    case BAREWORD:
		if (start[scanned+TclParseAllWhiteSpace(
			start+scanned, numBytes-scanned)] == '(') {
		    nodePtr->lexeme = FUNCTION;
		} else {
		    Tcl_Obj *objPtr = Tcl_NewStringObj(start, scanned);

		    Tcl_IncrRefCount(objPtr);
		    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
		    Tcl_DecrRefCount(objPtr);
		    if (code == TCL_OK) {
			nodePtr->lexeme = BOOLEAN;
		    } else {
			msg = Tcl_ObjPrintf(
︙
1312
1313
1314
1315
1316
1317
1318
1319
1320


1321
1322
1323
1324
1325
1326
1327

1309
1310
1311
1312
1313
1314
1315


1316
1317
1318
1319
1320
1321
1322
1323
1324








-
-
+
+








			scratch.tokenPtr[lastNodePtr->token].start;

		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		if (operand[0] == '0') {
		    Tcl_Obj *copy = Tcl_NewStringObj(operand,
			    start + scanned - operand);
		    if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
			post = Tcl_NewStringObj(
				"looks like invalid octal number", -1);
			TclNewLiteralStringObj(post,
				"looks like invalid octal number");
		    }
		    Tcl_DecrRefCount(copy);
		}
		scanned = 0;
		insertMark = 1;
		code = TCL_ERROR;
		continue;
︙
1373
1374
1375
1376
1377
1378
1379
1380

1381
1382
1383
1384
1385
1386
1387

1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1384








-
+








		if (code != TCL_OK) {
		    scanned = scratch.term - start;
		    scanned += (scanned < numBytes);
		    continue;
		}
		tokenPtr = scratch.tokenPtr + nodePtr->token + 1;
		if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    msg = Tcl_NewStringObj("invalid character \"$\"", -1);
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    code = TCL_ERROR;
		    continue;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT:
︙
1406
1407
1408
1409
1410
1411
1412
1413

1414
1415
1416
1417
1418
1419
1420

1403
1404
1405
1406
1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
1417








-
+








		    Tcl_FreeParse(&nested);
		    if ((nested.term < end) && (*nested.term == ']')
			    && !nested.incomplete) {
			break;
		    }

		    if (start == end) {
			msg = Tcl_NewStringObj("missing close-bracket", -1);
			TclNewLiteralStringObj(msg, "missing close-bracket");
			parsePtr->term = tokenPtr->start;
			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
			parsePtr->incomplete = 1;
			code = TCL_ERROR;
			break;
		    }
		}
︙
1501
1502
1503
1504
1505
1506
1507
1508

1509
1510
1511
1512
1513
1514
1515

1516
1517
1518

1519
1520
1521
1522
1523
1524
1525

1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511

1512
1513
1514

1515
1516
1517
1518
1519
1520
1521
1522








-
+






-
+


-
+








		continue;
	    }


	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
		if (prec[lastNodePtr->lexeme] > precedence) {
		    if (lastNodePtr->lexeme == OPEN_PAREN) {
			msg = Tcl_NewStringObj("unbalanced open paren", -1);
			TclNewLiteralStringObj(msg, "unbalanced open paren");
		    } else if (lastNodePtr->lexeme == COMMA) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    } else if (lastNodePtr->lexeme == START) {
			msg = Tcl_NewStringObj("empty expression", -1);
			TclNewLiteralStringObj(msg, "empty expression");
		    }
		} else if (nodePtr->lexeme == CLOSE_PAREN) {
		    msg = Tcl_NewStringObj("unbalanced close paren", -1);
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		} else if ((nodePtr->lexeme == COMMA)
			&& (lastNodePtr->lexeme == OPEN_PAREN)
			&& (lastNodePtr[-1].lexeme == FUNCTION)) {
		    msg = Tcl_ObjPrintf(
			    "missing function argument at %s", mark);
		    scanned = 0;
		    insertMark = 1;
︙
1574
1575
1576
1577
1578
1579
1580
1581

1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597


1598
1599
1600
1601
1602
1603
1604
1605

1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592


1593
1594

1595
1596
1597
1598
1599
1600
1601








-
+














-
-
+
+
-








		/*
		 * Some checks before linking.
		 */

		if ((otherPtr->lexeme == OPEN_PAREN)
			&& (nodePtr->lexeme != CLOSE_PAREN)) {
		    lastOrphanPtr = otherPtr;
		    msg = Tcl_NewStringObj("unbalanced open paren", -1);
		    TclNewLiteralStringObj(msg, "unbalanced open paren");
		    code = TCL_ERROR;
		    break;
		}
		if ((otherPtr->lexeme == QUESTION)
			&& (lastOrphanPtr->lexeme != COLON)) {
		    msg = Tcl_ObjPrintf(
			    "missing operator \":\" at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    code = TCL_ERROR;
		    break;
		}
		if ((lastOrphanPtr->lexeme == COLON)
			&& (otherPtr->lexeme != QUESTION)) {
		    msg = Tcl_NewStringObj(
			    "unexpected operator \":\" without preceding \"?\"",
		    TclNewLiteralStringObj(msg,
			    "unexpected operator \":\" without preceding \"?\"");
			    -1);
		    code = TCL_ERROR;
		    break;
		}

		/*
		 * Link orphan as right operand of otherPtr.
		 */
︙
1627
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649


1650
1651
1652
1653
1654
1655
1656


1657
1658
1659
1660
1661
1662
1663
1664

1623
1624
1625
1626
1627
1628
1629

1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643


1644
1645
1646
1647
1648
1649
1650


1651
1652

1653
1654
1655
1656
1657
1658
1659








-
+













-
-
+
+





-
-
+
+
-








	    }
	    if (code != TCL_OK) {
		continue;
	    }

	    if (nodePtr->lexeme == CLOSE_PAREN) {
		if (otherPtr->lexeme == START) {
		    msg = Tcl_NewStringObj("unbalanced close paren", -1);
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    code = TCL_ERROR;
		    continue;
		}

		/*
		 * Create no node for a CLOSE_PAREN lexeme.
		 */

		break;
	    }

	    if ((nodePtr->lexeme == COMMA) && ((otherPtr->lexeme != OPEN_PAREN)
		    || (otherPtr[-1].lexeme != FUNCTION))) {
		msg = Tcl_NewStringObj(
			"unexpected \",\" outside function argument list", -1);
		TclNewLiteralStringObj(msg,
			"unexpected \",\" outside function argument list");
		code = TCL_ERROR;
		continue;
	    }

	    if (lastOrphanPtr->lexeme == COLON) {
		msg = Tcl_NewStringObj(
			"unexpected operator \":\" without preceding \"?\"",
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
			-1);
		code = TCL_ERROR;
		continue;
	    }

	    /*
	     * Link orphan as left operand of new node.
	     */
︙
This page was created in about 0.026s by Fossil version [1205ec86cb] 2025-04-30 16:57:32