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.36 2006/11/13 08:23:07 das Exp $
* RCS: @(#) $Id: tclCompExpr.c,v 1.37 2006/11/15 20:08:43 dgp Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* The ExprNode structure represents one node of the parse tree produced
|
| ︙ | | |
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
-
+
-
+
-
+
-
+
-
+
|
scanned = ParseLexeme(start, numBytes, &(nodePtr->lexeme));
/* Use context to categorize the lexemes that are ambiguous */
if ((NODE_TYPE & nodePtr->lexeme) == 0) {
switch (nodePtr->lexeme) {
case INVALID:
msg = TclObjPrintf(
msg = Tcl_ObjPrintf(
"invalid character \"%.*s\"", scanned, start);
code = TCL_ERROR;
continue;
case INCOMPLETE:
msg = TclObjPrintf(
msg = Tcl_ObjPrintf(
"incomplete operator \"%.*s\"", scanned, start);
code = TCL_ERROR;
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 = TclObjPrintf(
msg = Tcl_ObjPrintf(
"invalid bareword \"%.*s%s\"",
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...");
post = TclObjPrintf(
post = Tcl_ObjPrintf(
"should be \"$%.*s%s\" or \"{%.*s%s}\"",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
TclAppendPrintfToObj(post,
Tcl_AppendPrintfToObj(post,
" or \"%.*s%s(...)\" or ...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
continue;
}
}
break;
|
| ︙ | | |
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
-
+
|
case LEAF: {
CONST char *end;
if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
CONST char *operand =
scratch.tokenPtr[lastNodePtr->token].start;
msg = TclObjPrintf("missing operator at %s", mark);
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);
}
|
| ︙ | | |
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
|
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
|
-
+
|
lastOrphanPtr = nodePtr;
nodesUsed++;
break;
}
case UNARY:
if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
msg = TclObjPrintf("missing operator at %s", mark);
msg = Tcl_ObjPrintf("missing operator at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
continue;
}
nodePtr->left = -1;
nodePtr->right = -1;
|
| ︙ | | |
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
-
+
-
+
-
+
-
+
|
nodePtr->token = -1;
lastOrphanPtr = nodePtr;
nodesUsed++;
break;
}
msg = TclObjPrintf("empty subexpression at %s", mark);
msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
continue;
}
if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
if (prec[lastNodePtr->lexeme] > precedence) {
if (lastNodePtr->lexeme == OPEN_PAREN) {
msg = Tcl_NewStringObj("unbalanced open paren", -1);
} else if (lastNodePtr->lexeme == COMMA) {
msg = TclObjPrintf(
msg = Tcl_ObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
} else if (lastNodePtr->lexeme == START) {
msg = Tcl_NewStringObj("empty expression", -1);
}
} else {
if (nodePtr->lexeme == CLOSE_PAREN) {
msg = Tcl_NewStringObj("unbalanced close paren", -1);
} else if ((nodePtr->lexeme == COMMA)
&& (lastNodePtr->lexeme == OPEN_PAREN)
&& (lastNodePtr[-1].lexeme == FUNCTION)) {
msg = TclObjPrintf(
msg = Tcl_ObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
}
}
if (msg == NULL) {
msg = TclObjPrintf("missing operand at %s", mark);
msg = Tcl_ObjPrintf("missing operand at %s", mark);
scanned = 0;
insertMark = 1;
}
code = TCL_ERROR;
continue;
}
|
| ︙ | | |
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
|
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
|
-
+
|
lastOrphanPtr = otherPtr;
msg = Tcl_NewStringObj("unbalanced open paren", -1);
code = TCL_ERROR;
break;
}
if ((otherPtr->lexeme == QUESTION)
&& (lastOrphanPtr->lexeme != COLON)) {
msg = TclObjPrintf(
msg = Tcl_ObjPrintf(
"missing operator \":\" at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
break;
}
if ((lastOrphanPtr->lexeme == COLON)
|
| ︙ | | |
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
|
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
|
-
+
-
+
|
if (msg) {
Tcl_DecrRefCount(msg);
}
} else {
if (msg == NULL) {
msg = Tcl_GetObjResult(interp);
}
TclAppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
((start - limit) < scratch.string) ? "" : "...",
((start - limit) < scratch.string)
? (start - scratch.string) : limit - 3,
((start - limit) < scratch.string)
? scratch.string : start - limit + 3,
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...",
insertMark ? mark : "",
(start + scanned + limit > scratch.end)
? scratch.end - (start + scanned) : limit-3,
start + scanned,
(start + scanned + limit > scratch.end) ? "" : "..."
);
if (post != NULL) {
Tcl_AppendToObj(msg, ";\n", -1);
Tcl_AppendObjToObj(msg, post);
Tcl_DecrRefCount(post);
}
Tcl_SetObjResult(interp, msg);
numBytes = scratch.end - scratch.string;
TclAppendObjToErrorInfo(interp, TclObjPrintf(
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (parsing expression \"%.*s%s\")",
(numBytes < limit) ? numBytes : limit - 3,
scratch.string, (numBytes < limit) ? "" : "..."));
}
}
if (nodes != staticNodes) {
|
| ︙ | | |