1 | /* |
---|
2 | * tclParse.c -- |
---|
3 | * |
---|
4 | * This file contains functions that parse Tcl scripts. They do so in a |
---|
5 | * general-purpose fashion that can be used for many different purposes, |
---|
6 | * including compilation, direct execution, code analysis, etc. |
---|
7 | * |
---|
8 | * Copyright (c) 1997 Sun Microsystems, Inc. |
---|
9 | * Copyright (c) 1998-2000 Ajuba Solutions. |
---|
10 | * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) |
---|
11 | * |
---|
12 | * See the file "license.terms" for information on usage and redistribution of |
---|
13 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
14 | * |
---|
15 | * RCS: @(#) $Id: tclParse.c,v 1.62 2008/01/23 21:58:36 dgp Exp $ |
---|
16 | */ |
---|
17 | |
---|
18 | #include "tclInt.h" |
---|
19 | |
---|
20 | /* |
---|
21 | * The following table provides parsing information about each possible 8-bit |
---|
22 | * character. The table is designed to be referenced with either signed or |
---|
23 | * unsigned characters, so it has 384 entries. The first 128 entries |
---|
24 | * correspond to negative character values, the next 256 correspond to |
---|
25 | * positive character values. The last 128 entries are identical to the first |
---|
26 | * 128. The table is always indexed with a 128-byte offset (the 128th entry |
---|
27 | * corresponds to a character value of 0). |
---|
28 | * |
---|
29 | * The macro CHAR_TYPE is used to index into the table and return information |
---|
30 | * about its character argument. The following return values are defined. |
---|
31 | * |
---|
32 | * TYPE_NORMAL - All characters that don't have special significance to |
---|
33 | * the Tcl parser. |
---|
34 | * TYPE_SPACE - The character is a whitespace character other than |
---|
35 | * newline. |
---|
36 | * TYPE_COMMAND_END - Character is newline or semicolon. |
---|
37 | * TYPE_SUBS - Character begins a substitution or has other special |
---|
38 | * meaning in ParseTokens: backslash, dollar sign, or |
---|
39 | * open bracket. |
---|
40 | * TYPE_QUOTE - Character is a double quote. |
---|
41 | * TYPE_CLOSE_PAREN - Character is a right parenthesis. |
---|
42 | * TYPE_CLOSE_BRACK - Character is a right square bracket. |
---|
43 | * TYPE_BRACE - Character is a curly brace (either left or right). |
---|
44 | */ |
---|
45 | |
---|
46 | #define TYPE_NORMAL 0 |
---|
47 | #define TYPE_SPACE 0x1 |
---|
48 | #define TYPE_COMMAND_END 0x2 |
---|
49 | #define TYPE_SUBS 0x4 |
---|
50 | #define TYPE_QUOTE 0x8 |
---|
51 | #define TYPE_CLOSE_PAREN 0x10 |
---|
52 | #define TYPE_CLOSE_BRACK 0x20 |
---|
53 | #define TYPE_BRACE 0x40 |
---|
54 | |
---|
55 | #define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] |
---|
56 | |
---|
57 | static const char charTypeTable[] = { |
---|
58 | /* |
---|
59 | * Negative character values, from -128 to -1: |
---|
60 | */ |
---|
61 | |
---|
62 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
63 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
64 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
65 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
66 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
67 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
68 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
69 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
70 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
71 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
72 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
73 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
74 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
75 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
76 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
77 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
78 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
79 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
80 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
81 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
82 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
83 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
84 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
85 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
86 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
87 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
88 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
89 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
90 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
91 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
92 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
93 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
94 | |
---|
95 | /* |
---|
96 | * Positive character values, from 0-127: |
---|
97 | */ |
---|
98 | |
---|
99 | TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
100 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
101 | TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, |
---|
102 | TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, |
---|
103 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
104 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
105 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
106 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
107 | TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, |
---|
108 | TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
109 | TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, |
---|
110 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
111 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
112 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
113 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, |
---|
114 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
115 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
116 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
117 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
118 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
119 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
120 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
121 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, |
---|
122 | TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, |
---|
123 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
124 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
125 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
126 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
127 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
128 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
129 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, |
---|
130 | TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL, |
---|
131 | |
---|
132 | /* |
---|
133 | * Large unsigned character values, from 128-255: |
---|
134 | */ |
---|
135 | |
---|
136 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
137 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
138 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
139 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
140 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
141 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
142 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
143 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
144 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
145 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
146 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
147 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
148 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
149 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
150 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
151 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
152 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
153 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
154 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
155 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
156 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
157 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
158 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
159 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
160 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
161 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
162 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
163 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
164 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
165 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
166 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
167 | TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
---|
168 | }; |
---|
169 | |
---|
170 | /* |
---|
171 | * Prototypes for local functions defined in this file: |
---|
172 | */ |
---|
173 | |
---|
174 | static inline int CommandComplete(const char *script, int numBytes); |
---|
175 | static int ParseComment(const char *src, int numBytes, |
---|
176 | Tcl_Parse *parsePtr); |
---|
177 | static int ParseTokens(const char *src, int numBytes, int mask, |
---|
178 | int flags, Tcl_Parse *parsePtr); |
---|
179 | static int ParseWhiteSpace(const char *src, int numBytes, |
---|
180 | int *incompletePtr, char *typePtr); |
---|
181 | |
---|
182 | /* |
---|
183 | *---------------------------------------------------------------------- |
---|
184 | * |
---|
185 | * TclParseInit -- |
---|
186 | * |
---|
187 | * Initialize the fields of a Tcl_Parse struct. |
---|
188 | * |
---|
189 | * Results: |
---|
190 | * None. |
---|
191 | * |
---|
192 | * Side effects: |
---|
193 | * The Tcl_Parse struct pointed to by parsePtr gets initialized. |
---|
194 | * |
---|
195 | *---------------------------------------------------------------------- |
---|
196 | */ |
---|
197 | |
---|
198 | void |
---|
199 | TclParseInit( |
---|
200 | Tcl_Interp *interp, /* Interpreter to use for error reporting */ |
---|
201 | const char *start, /* Start of string to be parsed. */ |
---|
202 | int numBytes, /* Total number of bytes in string. If < 0, |
---|
203 | * the script consists of all bytes up to the |
---|
204 | * first null character. */ |
---|
205 | Tcl_Parse *parsePtr) /* Points to struct to initialize */ |
---|
206 | { |
---|
207 | parsePtr->numWords = 0; |
---|
208 | parsePtr->tokenPtr = parsePtr->staticTokens; |
---|
209 | parsePtr->numTokens = 0; |
---|
210 | parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
---|
211 | parsePtr->string = start; |
---|
212 | parsePtr->end = start + numBytes; |
---|
213 | parsePtr->term = parsePtr->end; |
---|
214 | parsePtr->interp = interp; |
---|
215 | parsePtr->incomplete = 0; |
---|
216 | parsePtr->errorType = TCL_PARSE_SUCCESS; |
---|
217 | } |
---|
218 | |
---|
219 | /* |
---|
220 | *---------------------------------------------------------------------- |
---|
221 | * |
---|
222 | * Tcl_ParseCommand -- |
---|
223 | * |
---|
224 | * Given a string, this function parses the first Tcl command in the |
---|
225 | * string and returns information about the structure of the command. |
---|
226 | * |
---|
227 | * Results: |
---|
228 | * The return value is TCL_OK if the command was parsed successfully and |
---|
229 | * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an |
---|
230 | * error message is left in its result. On a successful return, parsePtr |
---|
231 | * is filled in with information about the command that was parsed. |
---|
232 | * |
---|
233 | * Side effects: |
---|
234 | * If there is insufficient space in parsePtr to hold all the information |
---|
235 | * about the command, then additional space is malloc-ed. If the function |
---|
236 | * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to |
---|
237 | * release any additional space that was allocated. |
---|
238 | * |
---|
239 | *---------------------------------------------------------------------- |
---|
240 | */ |
---|
241 | |
---|
242 | int |
---|
243 | Tcl_ParseCommand( |
---|
244 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if |
---|
245 | * NULL, then no error message is provided. */ |
---|
246 | const char *start, /* First character of string containing one or |
---|
247 | * more Tcl commands. */ |
---|
248 | register int numBytes, /* Total number of bytes in string. If < 0, |
---|
249 | * the script consists of all bytes up to the |
---|
250 | * first null character. */ |
---|
251 | int nested, /* Non-zero means this is a nested command: |
---|
252 | * close bracket should be considered a |
---|
253 | * command terminator. If zero, then close |
---|
254 | * bracket has no special meaning. */ |
---|
255 | register Tcl_Parse *parsePtr) |
---|
256 | /* Structure to fill in with information about |
---|
257 | * the parsed command; any previous |
---|
258 | * information in the structure is ignored. */ |
---|
259 | { |
---|
260 | register const char *src; /* Points to current character in the |
---|
261 | * command. */ |
---|
262 | char type; /* Result returned by CHAR_TYPE(*src). */ |
---|
263 | Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ |
---|
264 | int wordIndex; /* Index of word token for current word. */ |
---|
265 | int terminators; /* CHAR_TYPE bits that indicate the end of a |
---|
266 | * command. */ |
---|
267 | const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to |
---|
268 | * point to char after terminating one. */ |
---|
269 | int scanned; |
---|
270 | |
---|
271 | if ((start == NULL) && (numBytes != 0)) { |
---|
272 | if (interp != NULL) { |
---|
273 | Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); |
---|
274 | } |
---|
275 | return TCL_ERROR; |
---|
276 | } |
---|
277 | if (numBytes < 0) { |
---|
278 | numBytes = strlen(start); |
---|
279 | } |
---|
280 | TclParseInit(interp, start, numBytes, parsePtr); |
---|
281 | parsePtr->commentStart = NULL; |
---|
282 | parsePtr->commentSize = 0; |
---|
283 | parsePtr->commandStart = NULL; |
---|
284 | parsePtr->commandSize = 0; |
---|
285 | if (nested != 0) { |
---|
286 | terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK; |
---|
287 | } else { |
---|
288 | terminators = TYPE_COMMAND_END; |
---|
289 | } |
---|
290 | |
---|
291 | /* |
---|
292 | * Parse any leading space and comments before the first word of the |
---|
293 | * command. |
---|
294 | */ |
---|
295 | |
---|
296 | scanned = ParseComment(start, numBytes, parsePtr); |
---|
297 | src = (start + scanned); |
---|
298 | numBytes -= scanned; |
---|
299 | if (numBytes == 0) { |
---|
300 | if (nested) { |
---|
301 | parsePtr->incomplete = nested; |
---|
302 | } |
---|
303 | } |
---|
304 | |
---|
305 | /* |
---|
306 | * The following loop parses the words of the command, one word in each |
---|
307 | * iteration through the loop. |
---|
308 | */ |
---|
309 | |
---|
310 | parsePtr->commandStart = src; |
---|
311 | while (1) { |
---|
312 | int expandWord = 0; |
---|
313 | |
---|
314 | /* |
---|
315 | * Create the token for the word. |
---|
316 | */ |
---|
317 | |
---|
318 | TclGrowParseTokenArray(parsePtr, 1); |
---|
319 | wordIndex = parsePtr->numTokens; |
---|
320 | tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
---|
321 | tokenPtr->type = TCL_TOKEN_WORD; |
---|
322 | |
---|
323 | /* |
---|
324 | * Skip white space before the word. Also skip a backslash-newline |
---|
325 | * sequence: it should be treated just like white space. |
---|
326 | */ |
---|
327 | |
---|
328 | scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); |
---|
329 | src += scanned; |
---|
330 | numBytes -= scanned; |
---|
331 | if (numBytes == 0) { |
---|
332 | parsePtr->term = src; |
---|
333 | break; |
---|
334 | } |
---|
335 | if ((type & terminators) != 0) { |
---|
336 | parsePtr->term = src; |
---|
337 | src++; |
---|
338 | break; |
---|
339 | } |
---|
340 | tokenPtr->start = src; |
---|
341 | parsePtr->numTokens++; |
---|
342 | parsePtr->numWords++; |
---|
343 | |
---|
344 | /* |
---|
345 | * At this point the word can have one of four forms: something |
---|
346 | * enclosed in quotes, something enclosed in braces, and expanding |
---|
347 | * word, or an unquoted word (anything else). |
---|
348 | */ |
---|
349 | |
---|
350 | parseWord: |
---|
351 | if (*src == '"') { |
---|
352 | if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1, |
---|
353 | &termPtr) != TCL_OK) { |
---|
354 | goto error; |
---|
355 | } |
---|
356 | src = termPtr; |
---|
357 | numBytes = parsePtr->end - src; |
---|
358 | } else if (*src == '{') { |
---|
359 | int expIdx = wordIndex + 1; |
---|
360 | Tcl_Token *expPtr; |
---|
361 | |
---|
362 | if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1, |
---|
363 | &termPtr) != TCL_OK) { |
---|
364 | goto error; |
---|
365 | } |
---|
366 | src = termPtr; |
---|
367 | numBytes = parsePtr->end - src; |
---|
368 | |
---|
369 | /* |
---|
370 | * Check whether the braces contained the word expansion prefix |
---|
371 | * {*} |
---|
372 | */ |
---|
373 | |
---|
374 | expPtr = &parsePtr->tokenPtr[expIdx]; |
---|
375 | if ((0 == expandWord) |
---|
376 | /* Haven't seen prefix already */ |
---|
377 | && (1 == parsePtr->numTokens - expIdx) |
---|
378 | /* Only one token */ |
---|
379 | && (((1 == (size_t) expPtr->size) |
---|
380 | /* Same length as prefix */ |
---|
381 | && (expPtr->start[0] == '*'))) |
---|
382 | /* Is the prefix */ |
---|
383 | && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr, |
---|
384 | numBytes, &parsePtr->incomplete, &type)) |
---|
385 | && (type != TYPE_COMMAND_END) |
---|
386 | /* Non-whitespace follows */) { |
---|
387 | expandWord = 1; |
---|
388 | parsePtr->numTokens--; |
---|
389 | goto parseWord; |
---|
390 | } |
---|
391 | } else { |
---|
392 | /* |
---|
393 | * This is an unquoted word. Call ParseTokens and let it do all of |
---|
394 | * the work. |
---|
395 | */ |
---|
396 | |
---|
397 | if (ParseTokens(src, numBytes, TYPE_SPACE|terminators, |
---|
398 | TCL_SUBST_ALL, parsePtr) != TCL_OK) { |
---|
399 | goto error; |
---|
400 | } |
---|
401 | src = parsePtr->term; |
---|
402 | numBytes = parsePtr->end - src; |
---|
403 | } |
---|
404 | |
---|
405 | /* |
---|
406 | * Finish filling in the token for the word and check for the special |
---|
407 | * case of a word consisting of a single range of literal text. |
---|
408 | */ |
---|
409 | |
---|
410 | tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
---|
411 | tokenPtr->size = src - tokenPtr->start; |
---|
412 | tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); |
---|
413 | if (expandWord) { |
---|
414 | int i, isLiteral = 1; |
---|
415 | |
---|
416 | /* |
---|
417 | * When a command includes a word that is an expanded literal; for |
---|
418 | * example, {*}{1 2 3}, the parser performs that expansion |
---|
419 | * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead |
---|
420 | * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand() |
---|
421 | * caller might have to expand. This notably makes it simpler for |
---|
422 | * those callers that wish to track line endings, such as those |
---|
423 | * that implement key parts of TIP 280. |
---|
424 | * |
---|
425 | * First check whether the thing to be expanded is a literal, |
---|
426 | * in the sense of being composed entirely of TCL_TOKEN_TEXT |
---|
427 | * tokens. |
---|
428 | */ |
---|
429 | |
---|
430 | for (i = 1; i <= tokenPtr->numComponents; i++) { |
---|
431 | if (tokenPtr[i].type != TCL_TOKEN_TEXT) { |
---|
432 | isLiteral = 0; |
---|
433 | break; |
---|
434 | } |
---|
435 | } |
---|
436 | |
---|
437 | if (isLiteral) { |
---|
438 | int elemCount = 0, code = TCL_OK; |
---|
439 | const char *nextElem, *listEnd, *elemStart; |
---|
440 | |
---|
441 | /* |
---|
442 | * The word to be expanded is a literal, so determine the |
---|
443 | * boundaries of the literal string to be treated as a list |
---|
444 | * and expanded. That literal string starts at |
---|
445 | * tokenPtr[1].start, and includes all bytes up to, but not |
---|
446 | * including (tokenPtr[tokenPtr->numComponents].start + |
---|
447 | * tokenPtr[tokenPtr->numComponents].size) |
---|
448 | */ |
---|
449 | |
---|
450 | listEnd = (tokenPtr[tokenPtr->numComponents].start + |
---|
451 | tokenPtr[tokenPtr->numComponents].size); |
---|
452 | nextElem = tokenPtr[1].start; |
---|
453 | |
---|
454 | /* |
---|
455 | * Step through the literal string, parsing and counting list |
---|
456 | * elements. |
---|
457 | */ |
---|
458 | |
---|
459 | while (nextElem < listEnd) { |
---|
460 | code = TclFindElement(NULL, nextElem, listEnd - nextElem, |
---|
461 | &elemStart, &nextElem, NULL, NULL); |
---|
462 | if (code != TCL_OK) break; |
---|
463 | if (elemStart < listEnd) { |
---|
464 | elemCount++; |
---|
465 | } |
---|
466 | } |
---|
467 | |
---|
468 | if (code != TCL_OK) { |
---|
469 | /* |
---|
470 | * Some list element could not be parsed. This means the |
---|
471 | * literal string was not in fact a valid list. Defer the |
---|
472 | * handling of this to compile/eval time, where code is |
---|
473 | * already in place to report the "attempt to expand a |
---|
474 | * non-list" error. |
---|
475 | */ |
---|
476 | |
---|
477 | tokenPtr->type = TCL_TOKEN_EXPAND_WORD; |
---|
478 | } else if (elemCount == 0) { |
---|
479 | /* |
---|
480 | * We are expanding a literal empty list. This means that |
---|
481 | * the expanding word completely disappears, leaving no |
---|
482 | * word generated this pass through the loop. Adjust |
---|
483 | * accounting appropriately. |
---|
484 | */ |
---|
485 | |
---|
486 | parsePtr->numWords--; |
---|
487 | parsePtr->numTokens = wordIndex; |
---|
488 | } else { |
---|
489 | /* |
---|
490 | * Recalculate the number of Tcl_Tokens needed to store |
---|
491 | * tokens representing the expanded list. |
---|
492 | */ |
---|
493 | |
---|
494 | int growthNeeded = wordIndex + 2*elemCount |
---|
495 | - parsePtr->numTokens; |
---|
496 | parsePtr->numWords += elemCount - 1; |
---|
497 | if (growthNeeded > 0) { |
---|
498 | TclGrowParseTokenArray(parsePtr, growthNeeded); |
---|
499 | tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
---|
500 | } |
---|
501 | parsePtr->numTokens = wordIndex + 2*elemCount; |
---|
502 | |
---|
503 | /* |
---|
504 | * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for |
---|
505 | * each element of the literal list we are expanding in |
---|
506 | * place. Take care with the start and size fields of each |
---|
507 | * token so they point to the right literal characters in |
---|
508 | * the original script to represent the right expanded |
---|
509 | * word value. |
---|
510 | */ |
---|
511 | |
---|
512 | nextElem = tokenPtr[1].start; |
---|
513 | while (isspace(UCHAR(*nextElem))) { |
---|
514 | nextElem++; |
---|
515 | } |
---|
516 | while (nextElem < listEnd) { |
---|
517 | tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; |
---|
518 | tokenPtr->numComponents = 1; |
---|
519 | tokenPtr->start = nextElem; |
---|
520 | |
---|
521 | tokenPtr++; |
---|
522 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
523 | tokenPtr->numComponents = 0; |
---|
524 | TclFindElement(NULL, nextElem, listEnd - nextElem, |
---|
525 | &(tokenPtr->start), &nextElem, |
---|
526 | &(tokenPtr->size), NULL); |
---|
527 | if (tokenPtr->start + tokenPtr->size == listEnd) { |
---|
528 | tokenPtr[-1].size = listEnd - tokenPtr[-1].start; |
---|
529 | } else { |
---|
530 | tokenPtr[-1].size = tokenPtr->start |
---|
531 | + tokenPtr->size - tokenPtr[-1].start; |
---|
532 | tokenPtr[-1].size += (isspace(UCHAR( |
---|
533 | tokenPtr->start[tokenPtr->size])) == 0); |
---|
534 | } |
---|
535 | |
---|
536 | tokenPtr++; |
---|
537 | } |
---|
538 | } |
---|
539 | } else { |
---|
540 | /* |
---|
541 | * The word to be expanded is not a literal, so defer |
---|
542 | * expansion to compile/eval time by marking with a |
---|
543 | * TCL_TOKEN_EXPAND_WORD token. |
---|
544 | */ |
---|
545 | |
---|
546 | tokenPtr->type = TCL_TOKEN_EXPAND_WORD; |
---|
547 | } |
---|
548 | } else if ((tokenPtr->numComponents == 1) |
---|
549 | && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { |
---|
550 | tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; |
---|
551 | } |
---|
552 | |
---|
553 | /* |
---|
554 | * Do two additional checks: (a) make sure we're really at the end of |
---|
555 | * a word (there might have been garbage left after a quoted or braced |
---|
556 | * word), and (b) check for the end of the command. |
---|
557 | */ |
---|
558 | |
---|
559 | scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); |
---|
560 | if (scanned) { |
---|
561 | src += scanned; |
---|
562 | numBytes -= scanned; |
---|
563 | continue; |
---|
564 | } |
---|
565 | |
---|
566 | if (numBytes == 0) { |
---|
567 | parsePtr->term = src; |
---|
568 | break; |
---|
569 | } |
---|
570 | if ((type & terminators) != 0) { |
---|
571 | parsePtr->term = src; |
---|
572 | src++; |
---|
573 | break; |
---|
574 | } |
---|
575 | if (src[-1] == '"') { |
---|
576 | if (interp != NULL) { |
---|
577 | Tcl_SetResult(interp, "extra characters after close-quote", |
---|
578 | TCL_STATIC); |
---|
579 | } |
---|
580 | parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; |
---|
581 | } else { |
---|
582 | if (interp != NULL) { |
---|
583 | Tcl_SetResult(interp, "extra characters after close-brace", |
---|
584 | TCL_STATIC); |
---|
585 | } |
---|
586 | parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; |
---|
587 | } |
---|
588 | parsePtr->term = src; |
---|
589 | goto error; |
---|
590 | } |
---|
591 | |
---|
592 | parsePtr->commandSize = src - parsePtr->commandStart; |
---|
593 | return TCL_OK; |
---|
594 | |
---|
595 | error: |
---|
596 | Tcl_FreeParse(parsePtr); |
---|
597 | parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; |
---|
598 | return TCL_ERROR; |
---|
599 | } |
---|
600 | |
---|
601 | /* |
---|
602 | *---------------------------------------------------------------------- |
---|
603 | * |
---|
604 | * ParseWhiteSpace -- |
---|
605 | * |
---|
606 | * Scans up to numBytes bytes starting at src, consuming white space |
---|
607 | * between words as defined by Tcl's parsing rules. |
---|
608 | * |
---|
609 | * Results: |
---|
610 | * Returns the number of bytes recognized as white space. Records at |
---|
611 | * parsePtr, information about the parse. Records at typePtr the |
---|
612 | * character type of the non-whitespace character that terminated the |
---|
613 | * scan. |
---|
614 | * |
---|
615 | * Side effects: |
---|
616 | * None. |
---|
617 | * |
---|
618 | *---------------------------------------------------------------------- |
---|
619 | */ |
---|
620 | |
---|
621 | static int |
---|
622 | ParseWhiteSpace( |
---|
623 | const char *src, /* First character to parse. */ |
---|
624 | register int numBytes, /* Max number of bytes to scan. */ |
---|
625 | int *incompletePtr, /* Set this boolean memory to true if parsing |
---|
626 | * indicates an incomplete command. */ |
---|
627 | char *typePtr) /* Points to location to store character type |
---|
628 | * of character that ends run of whitespace */ |
---|
629 | { |
---|
630 | register char type = TYPE_NORMAL; |
---|
631 | register const char *p = src; |
---|
632 | |
---|
633 | while (1) { |
---|
634 | while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { |
---|
635 | numBytes--; |
---|
636 | p++; |
---|
637 | } |
---|
638 | if (numBytes && (type & TYPE_SUBS)) { |
---|
639 | if (*p != '\\') { |
---|
640 | break; |
---|
641 | } |
---|
642 | if (--numBytes == 0) { |
---|
643 | break; |
---|
644 | } |
---|
645 | if (p[1] != '\n') { |
---|
646 | break; |
---|
647 | } |
---|
648 | p+=2; |
---|
649 | if (--numBytes == 0) { |
---|
650 | *incompletePtr = 1; |
---|
651 | break; |
---|
652 | } |
---|
653 | continue; |
---|
654 | } |
---|
655 | break; |
---|
656 | } |
---|
657 | *typePtr = type; |
---|
658 | return (p - src); |
---|
659 | } |
---|
660 | |
---|
661 | /* |
---|
662 | *---------------------------------------------------------------------- |
---|
663 | * |
---|
664 | * TclParseAllWhiteSpace -- |
---|
665 | * |
---|
666 | * Scans up to numBytes bytes starting at src, consuming all white space |
---|
667 | * including the command-terminating newline characters. |
---|
668 | * |
---|
669 | * Results: |
---|
670 | * Returns the number of bytes recognized as white space. |
---|
671 | * |
---|
672 | *---------------------------------------------------------------------- |
---|
673 | */ |
---|
674 | |
---|
675 | int |
---|
676 | TclParseAllWhiteSpace( |
---|
677 | const char *src, /* First character to parse. */ |
---|
678 | int numBytes) /* Max number of byes to scan */ |
---|
679 | { |
---|
680 | int dummy; |
---|
681 | char type; |
---|
682 | const char *p = src; |
---|
683 | |
---|
684 | do { |
---|
685 | int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); |
---|
686 | |
---|
687 | p += scanned; |
---|
688 | numBytes -= scanned; |
---|
689 | } while (numBytes && (*p == '\n') && (p++, --numBytes)); |
---|
690 | return (p-src); |
---|
691 | } |
---|
692 | |
---|
693 | /* |
---|
694 | *---------------------------------------------------------------------- |
---|
695 | * |
---|
696 | * TclParseHex -- |
---|
697 | * |
---|
698 | * Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing |
---|
699 | * \x and \u escape sequences). At most numBytes bytes are scanned. |
---|
700 | * |
---|
701 | * Results: |
---|
702 | * The numeric value is stored in *resultPtr. Returns the number of bytes |
---|
703 | * consumed. |
---|
704 | * |
---|
705 | * Notes: |
---|
706 | * Relies on the following properties of the ASCII character set, with |
---|
707 | * which UTF-8 is compatible: |
---|
708 | * |
---|
709 | * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' occupy |
---|
710 | * consecutive code points, and '0' < 'A' < 'a'. |
---|
711 | * |
---|
712 | *---------------------------------------------------------------------- |
---|
713 | */ |
---|
714 | |
---|
715 | int |
---|
716 | TclParseHex( |
---|
717 | const char *src, /* First character to parse. */ |
---|
718 | int numBytes, /* Max number of byes to scan */ |
---|
719 | Tcl_UniChar *resultPtr) /* Points to storage provided by caller where |
---|
720 | * the Tcl_UniChar resulting from the |
---|
721 | * conversion is to be written. */ |
---|
722 | { |
---|
723 | Tcl_UniChar result = 0; |
---|
724 | register const char *p = src; |
---|
725 | |
---|
726 | while (numBytes--) { |
---|
727 | unsigned char digit = UCHAR(*p); |
---|
728 | |
---|
729 | if (!isxdigit(digit)) { |
---|
730 | break; |
---|
731 | } |
---|
732 | |
---|
733 | ++p; |
---|
734 | result <<= 4; |
---|
735 | |
---|
736 | if (digit >= 'a') { |
---|
737 | result |= (10 + digit - 'a'); |
---|
738 | } else if (digit >= 'A') { |
---|
739 | result |= (10 + digit - 'A'); |
---|
740 | } else { |
---|
741 | result |= (digit - '0'); |
---|
742 | } |
---|
743 | } |
---|
744 | |
---|
745 | *resultPtr = result; |
---|
746 | return (p - src); |
---|
747 | } |
---|
748 | |
---|
749 | /* |
---|
750 | *---------------------------------------------------------------------- |
---|
751 | * |
---|
752 | * TclParseBackslash -- |
---|
753 | * |
---|
754 | * Scans up to numBytes bytes starting at src, consuming a backslash |
---|
755 | * sequence as defined by Tcl's parsing rules. |
---|
756 | * |
---|
757 | * Results: |
---|
758 | * Records at readPtr the number of bytes making up the backslash |
---|
759 | * sequence. Records at dst the UTF-8 encoded equivalent of that |
---|
760 | * backslash sequence. Returns the number of bytes written to dst, at |
---|
761 | * most TCL_UTF_MAX. Either readPtr or dst may be NULL, if the results |
---|
762 | * are not needed, but the return value is the same either way. |
---|
763 | * |
---|
764 | * Side effects: |
---|
765 | * None. |
---|
766 | * |
---|
767 | *---------------------------------------------------------------------- |
---|
768 | */ |
---|
769 | |
---|
770 | int |
---|
771 | TclParseBackslash( |
---|
772 | const char *src, /* Points to the backslash character of a a |
---|
773 | * backslash sequence. */ |
---|
774 | int numBytes, /* Max number of bytes to scan. */ |
---|
775 | int *readPtr, /* NULL, or points to storage where the number |
---|
776 | * of bytes scanned should be written. */ |
---|
777 | char *dst) /* NULL, or points to buffer where the UTF-8 |
---|
778 | * encoding of the backslash sequence is to be |
---|
779 | * written. At most TCL_UTF_MAX bytes will be |
---|
780 | * written there. */ |
---|
781 | { |
---|
782 | register const char *p = src+1; |
---|
783 | Tcl_UniChar result; |
---|
784 | int count; |
---|
785 | char buf[TCL_UTF_MAX]; |
---|
786 | |
---|
787 | if (numBytes == 0) { |
---|
788 | if (readPtr != NULL) { |
---|
789 | *readPtr = 0; |
---|
790 | } |
---|
791 | return 0; |
---|
792 | } |
---|
793 | |
---|
794 | if (dst == NULL) { |
---|
795 | dst = buf; |
---|
796 | } |
---|
797 | |
---|
798 | if (numBytes == 1) { |
---|
799 | /* |
---|
800 | * Can only scan the backslash, so return it. |
---|
801 | */ |
---|
802 | |
---|
803 | result = '\\'; |
---|
804 | count = 1; |
---|
805 | goto done; |
---|
806 | } |
---|
807 | |
---|
808 | count = 2; |
---|
809 | switch (*p) { |
---|
810 | /* |
---|
811 | * Note: in the conversions below, use absolute values (e.g., 0xa) |
---|
812 | * rather than symbolic values (e.g. \n) that get converted by the |
---|
813 | * compiler. It's possible that compilers on some platforms will do |
---|
814 | * the symbolic conversions differently, which could result in |
---|
815 | * non-portable Tcl scripts. |
---|
816 | */ |
---|
817 | |
---|
818 | case 'a': |
---|
819 | result = 0x7; |
---|
820 | break; |
---|
821 | case 'b': |
---|
822 | result = 0x8; |
---|
823 | break; |
---|
824 | case 'f': |
---|
825 | result = 0xc; |
---|
826 | break; |
---|
827 | case 'n': |
---|
828 | result = 0xa; |
---|
829 | break; |
---|
830 | case 'r': |
---|
831 | result = 0xd; |
---|
832 | break; |
---|
833 | case 't': |
---|
834 | result = 0x9; |
---|
835 | break; |
---|
836 | case 'v': |
---|
837 | result = 0xb; |
---|
838 | break; |
---|
839 | case 'x': |
---|
840 | count += TclParseHex(p+1, numBytes-1, &result); |
---|
841 | if (count == 2) { |
---|
842 | /* |
---|
843 | * No hexadigits -> This is just "x". |
---|
844 | */ |
---|
845 | |
---|
846 | result = 'x'; |
---|
847 | } else { |
---|
848 | /* |
---|
849 | * Keep only the last byte (2 hex digits). |
---|
850 | */ |
---|
851 | result = (unsigned char) result; |
---|
852 | } |
---|
853 | break; |
---|
854 | case 'u': |
---|
855 | count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result); |
---|
856 | if (count == 2) { |
---|
857 | /* |
---|
858 | * No hexadigits -> This is just "u". |
---|
859 | */ |
---|
860 | result = 'u'; |
---|
861 | } |
---|
862 | break; |
---|
863 | case '\n': |
---|
864 | count--; |
---|
865 | do { |
---|
866 | p++; |
---|
867 | count++; |
---|
868 | } while ((count < numBytes) && ((*p == ' ') || (*p == '\t'))); |
---|
869 | result = ' '; |
---|
870 | break; |
---|
871 | case 0: |
---|
872 | result = '\\'; |
---|
873 | count = 1; |
---|
874 | break; |
---|
875 | default: |
---|
876 | /* |
---|
877 | * Check for an octal number \oo?o? |
---|
878 | */ |
---|
879 | |
---|
880 | if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ |
---|
881 | result = (unsigned char)(*p - '0'); |
---|
882 | p++; |
---|
883 | if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ |
---|
884 | || (UCHAR(*p) >= '8')) { |
---|
885 | break; |
---|
886 | } |
---|
887 | count = 3; |
---|
888 | result = (unsigned char)((result << 3) + (*p - '0')); |
---|
889 | p++; |
---|
890 | if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ |
---|
891 | || (UCHAR(*p) >= '8')) { |
---|
892 | break; |
---|
893 | } |
---|
894 | count = 4; |
---|
895 | result = (unsigned char)((result << 3) + (*p - '0')); |
---|
896 | break; |
---|
897 | } |
---|
898 | |
---|
899 | /* |
---|
900 | * We have to convert here in case the user has put a backslash in |
---|
901 | * front of a multi-byte utf-8 character. While this means nothing |
---|
902 | * special, we shouldn't break up a correct utf-8 character. [Bug |
---|
903 | * #217987] test subst-3.2 |
---|
904 | */ |
---|
905 | |
---|
906 | if (Tcl_UtfCharComplete(p, numBytes - 1)) { |
---|
907 | count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ |
---|
908 | } else { |
---|
909 | char utfBytes[TCL_UTF_MAX]; |
---|
910 | |
---|
911 | memcpy(utfBytes, p, (size_t) (numBytes - 1)); |
---|
912 | utfBytes[numBytes - 1] = '\0'; |
---|
913 | count = Tcl_UtfToUniChar(utfBytes, &result) + 1; |
---|
914 | } |
---|
915 | break; |
---|
916 | } |
---|
917 | |
---|
918 | done: |
---|
919 | if (readPtr != NULL) { |
---|
920 | *readPtr = count; |
---|
921 | } |
---|
922 | return Tcl_UniCharToUtf((int) result, dst); |
---|
923 | } |
---|
924 | |
---|
925 | /* |
---|
926 | *---------------------------------------------------------------------- |
---|
927 | * |
---|
928 | * ParseComment -- |
---|
929 | * |
---|
930 | * Scans up to numBytes bytes starting at src, consuming a Tcl comment as |
---|
931 | * defined by Tcl's parsing rules. |
---|
932 | * |
---|
933 | * Results: |
---|
934 | * Records in parsePtr information about the parse. Returns the number of |
---|
935 | * bytes consumed. |
---|
936 | * |
---|
937 | * Side effects: |
---|
938 | * None. |
---|
939 | * |
---|
940 | *---------------------------------------------------------------------- |
---|
941 | */ |
---|
942 | |
---|
943 | static int |
---|
944 | ParseComment( |
---|
945 | const char *src, /* First character to parse. */ |
---|
946 | register int numBytes, /* Max number of bytes to scan. */ |
---|
947 | Tcl_Parse *parsePtr) /* Information about parse in progress. |
---|
948 | * Updated if parsing indicates an incomplete |
---|
949 | * command. */ |
---|
950 | { |
---|
951 | register const char *p = src; |
---|
952 | |
---|
953 | while (numBytes) { |
---|
954 | char type; |
---|
955 | int scanned; |
---|
956 | |
---|
957 | scanned = TclParseAllWhiteSpace(p, numBytes); |
---|
958 | p += scanned; |
---|
959 | numBytes -= scanned; |
---|
960 | |
---|
961 | if ((numBytes == 0) || (*p != '#')) { |
---|
962 | break; |
---|
963 | } |
---|
964 | if (parsePtr->commentStart == NULL) { |
---|
965 | parsePtr->commentStart = p; |
---|
966 | } |
---|
967 | |
---|
968 | while (numBytes) { |
---|
969 | if (*p == '\\') { |
---|
970 | scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete, |
---|
971 | &type); |
---|
972 | if (scanned) { |
---|
973 | p += scanned; |
---|
974 | numBytes -= scanned; |
---|
975 | } else { |
---|
976 | /* |
---|
977 | * General backslash substitution in comments isn't part |
---|
978 | * of the formal spec, but test parse-15.47 and history |
---|
979 | * indicate that it has been the de facto rule. Don't |
---|
980 | * change it now. |
---|
981 | */ |
---|
982 | |
---|
983 | TclParseBackslash(p, numBytes, &scanned, NULL); |
---|
984 | p += scanned; |
---|
985 | numBytes -= scanned; |
---|
986 | } |
---|
987 | } else { |
---|
988 | p++; |
---|
989 | numBytes--; |
---|
990 | if (p[-1] == '\n') { |
---|
991 | break; |
---|
992 | } |
---|
993 | } |
---|
994 | } |
---|
995 | parsePtr->commentSize = p - parsePtr->commentStart; |
---|
996 | } |
---|
997 | return (p - src); |
---|
998 | } |
---|
999 | |
---|
1000 | /* |
---|
1001 | *---------------------------------------------------------------------- |
---|
1002 | * |
---|
1003 | * ParseTokens -- |
---|
1004 | * |
---|
1005 | * This function forms the heart of the Tcl parser. It parses one or more |
---|
1006 | * tokens from a string, up to a termination point specified by the |
---|
1007 | * caller. This function is used to parse unquoted command words (those |
---|
1008 | * not in quotes or braces), words in quotes, and array indices for |
---|
1009 | * variables. No more than numBytes bytes will be scanned. |
---|
1010 | * |
---|
1011 | * Results: |
---|
1012 | * Tokens are added to parsePtr and parsePtr->term is filled in with the |
---|
1013 | * address of the character that terminated the parse (the first one |
---|
1014 | * whose CHAR_TYPE matched mask or the character at parsePtr->end). The |
---|
1015 | * return value is TCL_OK if the parse completed successfully and |
---|
1016 | * TCL_ERROR otherwise. If a parse error occurs and parsePtr->interp is |
---|
1017 | * not NULL, then an error message is left in the interpreter's result. |
---|
1018 | * |
---|
1019 | * Side effects: |
---|
1020 | * None. |
---|
1021 | * |
---|
1022 | *---------------------------------------------------------------------- |
---|
1023 | */ |
---|
1024 | |
---|
1025 | static int |
---|
1026 | ParseTokens( |
---|
1027 | register const char *src, /* First character to parse. */ |
---|
1028 | register int numBytes, /* Max number of bytes to scan. */ |
---|
1029 | int mask, /* Specifies when to stop parsing. The parse |
---|
1030 | * stops at the first unquoted character whose |
---|
1031 | * CHAR_TYPE contains any of the bits in |
---|
1032 | * mask. */ |
---|
1033 | int flags, /* OR-ed bits indicating what substitutions to |
---|
1034 | * perform: TCL_SUBST_COMMANDS, |
---|
1035 | * TCL_SUBST_VARIABLES, and |
---|
1036 | * TCL_SUBST_BACKSLASHES */ |
---|
1037 | Tcl_Parse *parsePtr) /* Information about parse in progress. |
---|
1038 | * Updated with additional tokens and |
---|
1039 | * termination information. */ |
---|
1040 | { |
---|
1041 | char type; |
---|
1042 | int originalTokens; |
---|
1043 | int noSubstCmds = !(flags & TCL_SUBST_COMMANDS); |
---|
1044 | int noSubstVars = !(flags & TCL_SUBST_VARIABLES); |
---|
1045 | int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES); |
---|
1046 | Tcl_Token *tokenPtr; |
---|
1047 | |
---|
1048 | /* |
---|
1049 | * Each iteration through the following loop adds one token of type |
---|
1050 | * TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or TCL_TOKEN_VARIABLE |
---|
1051 | * to parsePtr. For TCL_TOKEN_VARIABLE tokens, additional tokens are added |
---|
1052 | * for the parsed variable name. |
---|
1053 | */ |
---|
1054 | |
---|
1055 | originalTokens = parsePtr->numTokens; |
---|
1056 | while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { |
---|
1057 | TclGrowParseTokenArray(parsePtr, 1); |
---|
1058 | tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
---|
1059 | tokenPtr->start = src; |
---|
1060 | tokenPtr->numComponents = 0; |
---|
1061 | |
---|
1062 | if ((type & TYPE_SUBS) == 0) { |
---|
1063 | /* |
---|
1064 | * This is a simple range of characters. Scan to find the end of |
---|
1065 | * the range. |
---|
1066 | */ |
---|
1067 | |
---|
1068 | while ((++src, --numBytes) |
---|
1069 | && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) { |
---|
1070 | /* empty loop */ |
---|
1071 | } |
---|
1072 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1073 | tokenPtr->size = src - tokenPtr->start; |
---|
1074 | parsePtr->numTokens++; |
---|
1075 | } else if (*src == '$') { |
---|
1076 | int varToken; |
---|
1077 | |
---|
1078 | if (noSubstVars) { |
---|
1079 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1080 | tokenPtr->size = 1; |
---|
1081 | parsePtr->numTokens++; |
---|
1082 | src++; |
---|
1083 | numBytes--; |
---|
1084 | continue; |
---|
1085 | } |
---|
1086 | |
---|
1087 | /* |
---|
1088 | * This is a variable reference. Call Tcl_ParseVarName to do all |
---|
1089 | * the dirty work of parsing the name. |
---|
1090 | */ |
---|
1091 | |
---|
1092 | varToken = parsePtr->numTokens; |
---|
1093 | if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr, |
---|
1094 | 1) != TCL_OK) { |
---|
1095 | return TCL_ERROR; |
---|
1096 | } |
---|
1097 | src += parsePtr->tokenPtr[varToken].size; |
---|
1098 | numBytes -= parsePtr->tokenPtr[varToken].size; |
---|
1099 | } else if (*src == '[') { |
---|
1100 | Tcl_Parse *nestedPtr; |
---|
1101 | |
---|
1102 | if (noSubstCmds) { |
---|
1103 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1104 | tokenPtr->size = 1; |
---|
1105 | parsePtr->numTokens++; |
---|
1106 | src++; |
---|
1107 | numBytes--; |
---|
1108 | continue; |
---|
1109 | } |
---|
1110 | |
---|
1111 | /* |
---|
1112 | * Command substitution. Call Tcl_ParseCommand recursively (and |
---|
1113 | * repeatedly) to parse the nested command(s), then throw away the |
---|
1114 | * parse information. |
---|
1115 | */ |
---|
1116 | |
---|
1117 | src++; |
---|
1118 | numBytes--; |
---|
1119 | nestedPtr = (Tcl_Parse *) |
---|
1120 | TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); |
---|
1121 | while (1) { |
---|
1122 | if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, |
---|
1123 | nestedPtr) != TCL_OK) { |
---|
1124 | parsePtr->errorType = nestedPtr->errorType; |
---|
1125 | parsePtr->term = nestedPtr->term; |
---|
1126 | parsePtr->incomplete = nestedPtr->incomplete; |
---|
1127 | TclStackFree(parsePtr->interp, nestedPtr); |
---|
1128 | return TCL_ERROR; |
---|
1129 | } |
---|
1130 | src = nestedPtr->commandStart + nestedPtr->commandSize; |
---|
1131 | numBytes = parsePtr->end - src; |
---|
1132 | Tcl_FreeParse(nestedPtr); |
---|
1133 | |
---|
1134 | /* |
---|
1135 | * Check for the closing ']' that ends the command |
---|
1136 | * substitution. It must have been the last character of the |
---|
1137 | * parsed command. |
---|
1138 | */ |
---|
1139 | |
---|
1140 | if ((nestedPtr->term < parsePtr->end) |
---|
1141 | && (*(nestedPtr->term) == ']') |
---|
1142 | && !(nestedPtr->incomplete)) { |
---|
1143 | break; |
---|
1144 | } |
---|
1145 | if (numBytes == 0) { |
---|
1146 | if (parsePtr->interp != NULL) { |
---|
1147 | Tcl_SetResult(parsePtr->interp, |
---|
1148 | "missing close-bracket", TCL_STATIC); |
---|
1149 | } |
---|
1150 | parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; |
---|
1151 | parsePtr->term = tokenPtr->start; |
---|
1152 | parsePtr->incomplete = 1; |
---|
1153 | TclStackFree(parsePtr->interp, nestedPtr); |
---|
1154 | return TCL_ERROR; |
---|
1155 | } |
---|
1156 | } |
---|
1157 | TclStackFree(parsePtr->interp, nestedPtr); |
---|
1158 | tokenPtr->type = TCL_TOKEN_COMMAND; |
---|
1159 | tokenPtr->size = src - tokenPtr->start; |
---|
1160 | parsePtr->numTokens++; |
---|
1161 | } else if (*src == '\\') { |
---|
1162 | if (noSubstBS) { |
---|
1163 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1164 | tokenPtr->size = 1; |
---|
1165 | parsePtr->numTokens++; |
---|
1166 | src++; |
---|
1167 | numBytes--; |
---|
1168 | continue; |
---|
1169 | } |
---|
1170 | |
---|
1171 | /* |
---|
1172 | * Backslash substitution. |
---|
1173 | */ |
---|
1174 | |
---|
1175 | TclParseBackslash(src, numBytes, &tokenPtr->size, NULL); |
---|
1176 | |
---|
1177 | if (tokenPtr->size == 1) { |
---|
1178 | /* |
---|
1179 | * Just a backslash, due to end of string. |
---|
1180 | */ |
---|
1181 | |
---|
1182 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1183 | parsePtr->numTokens++; |
---|
1184 | src++; |
---|
1185 | numBytes--; |
---|
1186 | continue; |
---|
1187 | } |
---|
1188 | |
---|
1189 | if (src[1] == '\n') { |
---|
1190 | if (numBytes == 2) { |
---|
1191 | parsePtr->incomplete = 1; |
---|
1192 | } |
---|
1193 | |
---|
1194 | /* |
---|
1195 | * Note: backslash-newline is special in that it is treated |
---|
1196 | * the same as a space character would be. This means that it |
---|
1197 | * could terminate the token. |
---|
1198 | */ |
---|
1199 | |
---|
1200 | if (mask & TYPE_SPACE) { |
---|
1201 | if (parsePtr->numTokens == originalTokens) { |
---|
1202 | goto finishToken; |
---|
1203 | } |
---|
1204 | break; |
---|
1205 | } |
---|
1206 | } |
---|
1207 | |
---|
1208 | tokenPtr->type = TCL_TOKEN_BS; |
---|
1209 | parsePtr->numTokens++; |
---|
1210 | src += tokenPtr->size; |
---|
1211 | numBytes -= tokenPtr->size; |
---|
1212 | } else if (*src == 0) { |
---|
1213 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1214 | tokenPtr->size = 1; |
---|
1215 | parsePtr->numTokens++; |
---|
1216 | src++; |
---|
1217 | numBytes--; |
---|
1218 | } else { |
---|
1219 | Tcl_Panic("ParseTokens encountered unknown character"); |
---|
1220 | } |
---|
1221 | } |
---|
1222 | if (parsePtr->numTokens == originalTokens) { |
---|
1223 | /* |
---|
1224 | * There was nothing in this range of text. Add an empty token for the |
---|
1225 | * empty range, so that there is always at least one token added. |
---|
1226 | */ |
---|
1227 | |
---|
1228 | TclGrowParseTokenArray(parsePtr, 1); |
---|
1229 | tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
---|
1230 | tokenPtr->start = src; |
---|
1231 | tokenPtr->numComponents = 0; |
---|
1232 | |
---|
1233 | finishToken: |
---|
1234 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1235 | tokenPtr->size = 0; |
---|
1236 | parsePtr->numTokens++; |
---|
1237 | } |
---|
1238 | parsePtr->term = src; |
---|
1239 | return TCL_OK; |
---|
1240 | } |
---|
1241 | |
---|
1242 | /* |
---|
1243 | *---------------------------------------------------------------------- |
---|
1244 | * |
---|
1245 | * Tcl_FreeParse -- |
---|
1246 | * |
---|
1247 | * This function is invoked to free any dynamic storage that may have |
---|
1248 | * been allocated by a previous call to Tcl_ParseCommand. |
---|
1249 | * |
---|
1250 | * Results: |
---|
1251 | * None. |
---|
1252 | * |
---|
1253 | * Side effects: |
---|
1254 | * If there is any dynamically allocated memory in *parsePtr, it is |
---|
1255 | * freed. |
---|
1256 | * |
---|
1257 | *---------------------------------------------------------------------- |
---|
1258 | */ |
---|
1259 | |
---|
1260 | void |
---|
1261 | Tcl_FreeParse( |
---|
1262 | Tcl_Parse *parsePtr) /* Structure that was filled in by a previous |
---|
1263 | * call to Tcl_ParseCommand. */ |
---|
1264 | { |
---|
1265 | if (parsePtr->tokenPtr != parsePtr->staticTokens) { |
---|
1266 | ckfree((char *) parsePtr->tokenPtr); |
---|
1267 | parsePtr->tokenPtr = parsePtr->staticTokens; |
---|
1268 | } |
---|
1269 | } |
---|
1270 | |
---|
1271 | /* |
---|
1272 | *---------------------------------------------------------------------- |
---|
1273 | * |
---|
1274 | * Tcl_ParseVarName -- |
---|
1275 | * |
---|
1276 | * Given a string starting with a $ sign, parse off a variable name and |
---|
1277 | * return information about the parse. No more than numBytes bytes will |
---|
1278 | * be scanned. |
---|
1279 | * |
---|
1280 | * Results: |
---|
1281 | * The return value is TCL_OK if the command was parsed successfully and |
---|
1282 | * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an |
---|
1283 | * error message is left in its result. On a successful return, tokenPtr |
---|
1284 | * and numTokens fields of parsePtr are filled in with information about |
---|
1285 | * the variable name that was parsed. The "size" field of the first new |
---|
1286 | * token gives the total number of bytes in the variable name. Other |
---|
1287 | * fields in parsePtr are undefined. |
---|
1288 | * |
---|
1289 | * Side effects: |
---|
1290 | * If there is insufficient space in parsePtr to hold all the information |
---|
1291 | * about the command, then additional space is malloc-ed. If the function |
---|
1292 | * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to |
---|
1293 | * release any additional space that was allocated. |
---|
1294 | * |
---|
1295 | *---------------------------------------------------------------------- |
---|
1296 | */ |
---|
1297 | |
---|
1298 | int |
---|
1299 | Tcl_ParseVarName( |
---|
1300 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if |
---|
1301 | * NULL, then no error message is provided. */ |
---|
1302 | const char *start, /* Start of variable substitution string. |
---|
1303 | * First character must be "$". */ |
---|
1304 | register int numBytes, /* Total number of bytes in string. If < 0, |
---|
1305 | * the string consists of all bytes up to the |
---|
1306 | * first null character. */ |
---|
1307 | Tcl_Parse *parsePtr, /* Structure to fill in with information about |
---|
1308 | * the variable name. */ |
---|
1309 | int append) /* Non-zero means append tokens to existing |
---|
1310 | * information in parsePtr; zero means ignore |
---|
1311 | * existing tokens in parsePtr and |
---|
1312 | * reinitialize it. */ |
---|
1313 | { |
---|
1314 | Tcl_Token *tokenPtr; |
---|
1315 | register const char *src; |
---|
1316 | unsigned char c; |
---|
1317 | int varIndex, offset; |
---|
1318 | Tcl_UniChar ch; |
---|
1319 | unsigned array; |
---|
1320 | |
---|
1321 | if ((numBytes == 0) || (start == NULL)) { |
---|
1322 | return TCL_ERROR; |
---|
1323 | } |
---|
1324 | if (numBytes < 0) { |
---|
1325 | numBytes = strlen(start); |
---|
1326 | } |
---|
1327 | |
---|
1328 | if (!append) { |
---|
1329 | TclParseInit(interp, start, numBytes, parsePtr); |
---|
1330 | } |
---|
1331 | |
---|
1332 | /* |
---|
1333 | * Generate one token for the variable, an additional token for the name, |
---|
1334 | * plus any number of additional tokens for the index, if there is one. |
---|
1335 | */ |
---|
1336 | |
---|
1337 | src = start; |
---|
1338 | TclGrowParseTokenArray(parsePtr, 2); |
---|
1339 | tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
---|
1340 | tokenPtr->type = TCL_TOKEN_VARIABLE; |
---|
1341 | tokenPtr->start = src; |
---|
1342 | varIndex = parsePtr->numTokens; |
---|
1343 | parsePtr->numTokens++; |
---|
1344 | tokenPtr++; |
---|
1345 | src++; |
---|
1346 | numBytes--; |
---|
1347 | if (numBytes == 0) { |
---|
1348 | goto justADollarSign; |
---|
1349 | } |
---|
1350 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1351 | tokenPtr->start = src; |
---|
1352 | tokenPtr->numComponents = 0; |
---|
1353 | |
---|
1354 | /* |
---|
1355 | * The name of the variable can have three forms: |
---|
1356 | * 1. The $ sign is followed by an open curly brace. Then the variable |
---|
1357 | * name is everything up to the next close curly brace, and the |
---|
1358 | * variable is a scalar variable. |
---|
1359 | * 2. The $ sign is not followed by an open curly brace. Then the variable |
---|
1360 | * name is everything up to the next character that isn't a letter, |
---|
1361 | * digit, or underscore. :: sequences are also considered part of the |
---|
1362 | * variable name, in order to support namespaces. If the following |
---|
1363 | * character is an open parenthesis, then the information between |
---|
1364 | * parentheses is the array element name. |
---|
1365 | * 3. The $ sign is followed by something that isn't a letter, digit, or |
---|
1366 | * underscore: in this case, there is no variable name and the token is |
---|
1367 | * just "$". |
---|
1368 | */ |
---|
1369 | |
---|
1370 | if (*src == '{') { |
---|
1371 | src++; |
---|
1372 | numBytes--; |
---|
1373 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1374 | tokenPtr->start = src; |
---|
1375 | tokenPtr->numComponents = 0; |
---|
1376 | |
---|
1377 | while (numBytes && (*src != '}')) { |
---|
1378 | numBytes--; |
---|
1379 | src++; |
---|
1380 | } |
---|
1381 | if (numBytes == 0) { |
---|
1382 | if (parsePtr->interp != NULL) { |
---|
1383 | Tcl_SetResult(parsePtr->interp, |
---|
1384 | "missing close-brace for variable name", TCL_STATIC); |
---|
1385 | } |
---|
1386 | parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; |
---|
1387 | parsePtr->term = tokenPtr->start-1; |
---|
1388 | parsePtr->incomplete = 1; |
---|
1389 | goto error; |
---|
1390 | } |
---|
1391 | tokenPtr->size = src - tokenPtr->start; |
---|
1392 | tokenPtr[-1].size = src - tokenPtr[-1].start; |
---|
1393 | parsePtr->numTokens++; |
---|
1394 | src++; |
---|
1395 | } else { |
---|
1396 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1397 | tokenPtr->start = src; |
---|
1398 | tokenPtr->numComponents = 0; |
---|
1399 | |
---|
1400 | while (numBytes) { |
---|
1401 | if (Tcl_UtfCharComplete(src, numBytes)) { |
---|
1402 | offset = Tcl_UtfToUniChar(src, &ch); |
---|
1403 | } else { |
---|
1404 | char utfBytes[TCL_UTF_MAX]; |
---|
1405 | |
---|
1406 | memcpy(utfBytes, src, (size_t) numBytes); |
---|
1407 | utfBytes[numBytes] = '\0'; |
---|
1408 | offset = Tcl_UtfToUniChar(utfBytes, &ch); |
---|
1409 | } |
---|
1410 | c = UCHAR(ch); |
---|
1411 | if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ |
---|
1412 | src += offset; |
---|
1413 | numBytes -= offset; |
---|
1414 | continue; |
---|
1415 | } |
---|
1416 | if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { |
---|
1417 | src += 2; |
---|
1418 | numBytes -= 2; |
---|
1419 | while (numBytes && (*src == ':')) { |
---|
1420 | src++; |
---|
1421 | numBytes--; |
---|
1422 | } |
---|
1423 | continue; |
---|
1424 | } |
---|
1425 | break; |
---|
1426 | } |
---|
1427 | |
---|
1428 | /* |
---|
1429 | * Support for empty array names here. |
---|
1430 | */ |
---|
1431 | |
---|
1432 | array = (numBytes && (*src == '(')); |
---|
1433 | tokenPtr->size = src - tokenPtr->start; |
---|
1434 | if ((tokenPtr->size == 0) && !array) { |
---|
1435 | goto justADollarSign; |
---|
1436 | } |
---|
1437 | parsePtr->numTokens++; |
---|
1438 | if (array) { |
---|
1439 | /* |
---|
1440 | * This is a reference to an array element. Call ParseTokens |
---|
1441 | * recursively to parse the element name, since it could contain |
---|
1442 | * any number of substitutions. |
---|
1443 | */ |
---|
1444 | |
---|
1445 | if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, |
---|
1446 | TCL_SUBST_ALL, parsePtr)) { |
---|
1447 | goto error; |
---|
1448 | } |
---|
1449 | if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ |
---|
1450 | if (parsePtr->interp != NULL) { |
---|
1451 | Tcl_SetResult(parsePtr->interp, "missing )", |
---|
1452 | TCL_STATIC); |
---|
1453 | } |
---|
1454 | parsePtr->errorType = TCL_PARSE_MISSING_PAREN; |
---|
1455 | parsePtr->term = src; |
---|
1456 | parsePtr->incomplete = 1; |
---|
1457 | goto error; |
---|
1458 | } |
---|
1459 | src = parsePtr->term + 1; |
---|
1460 | } |
---|
1461 | } |
---|
1462 | tokenPtr = &parsePtr->tokenPtr[varIndex]; |
---|
1463 | tokenPtr->size = src - tokenPtr->start; |
---|
1464 | tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1); |
---|
1465 | return TCL_OK; |
---|
1466 | |
---|
1467 | /* |
---|
1468 | * The dollar sign isn't followed by a variable name. Replace the |
---|
1469 | * TCL_TOKEN_VARIABLE token with a TCL_TOKEN_TEXT token for the dollar |
---|
1470 | * sign. |
---|
1471 | */ |
---|
1472 | |
---|
1473 | justADollarSign: |
---|
1474 | tokenPtr = &parsePtr->tokenPtr[varIndex]; |
---|
1475 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1476 | tokenPtr->size = 1; |
---|
1477 | tokenPtr->numComponents = 0; |
---|
1478 | return TCL_OK; |
---|
1479 | |
---|
1480 | error: |
---|
1481 | Tcl_FreeParse(parsePtr); |
---|
1482 | return TCL_ERROR; |
---|
1483 | } |
---|
1484 | |
---|
1485 | /* |
---|
1486 | *---------------------------------------------------------------------- |
---|
1487 | * |
---|
1488 | * Tcl_ParseVar -- |
---|
1489 | * |
---|
1490 | * Given a string starting with a $ sign, parse off a variable name and |
---|
1491 | * return its value. |
---|
1492 | * |
---|
1493 | * Results: |
---|
1494 | * The return value is the contents of the variable given by the leading |
---|
1495 | * characters of string. If termPtr isn't NULL, *termPtr gets filled in |
---|
1496 | * with the address of the character just after the last one in the |
---|
1497 | * variable specifier. If the variable doesn't exist, then the return |
---|
1498 | * value is NULL and an error message will be left in interp's result. |
---|
1499 | * |
---|
1500 | * Side effects: |
---|
1501 | * None. |
---|
1502 | * |
---|
1503 | *---------------------------------------------------------------------- |
---|
1504 | */ |
---|
1505 | |
---|
1506 | const char * |
---|
1507 | Tcl_ParseVar( |
---|
1508 | Tcl_Interp *interp, /* Context for looking up variable. */ |
---|
1509 | register const char *start, /* Start of variable substitution. First |
---|
1510 | * character must be "$". */ |
---|
1511 | const char **termPtr) /* If non-NULL, points to word to fill in with |
---|
1512 | * character just after last one in the |
---|
1513 | * variable specifier. */ |
---|
1514 | { |
---|
1515 | register Tcl_Obj *objPtr; |
---|
1516 | int code; |
---|
1517 | Tcl_Parse *parsePtr = (Tcl_Parse *) |
---|
1518 | TclStackAlloc(interp, sizeof(Tcl_Parse)); |
---|
1519 | |
---|
1520 | if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { |
---|
1521 | TclStackFree(interp, parsePtr); |
---|
1522 | return NULL; |
---|
1523 | } |
---|
1524 | |
---|
1525 | if (termPtr != NULL) { |
---|
1526 | *termPtr = start + parsePtr->tokenPtr->size; |
---|
1527 | } |
---|
1528 | if (parsePtr->numTokens == 1) { |
---|
1529 | /* |
---|
1530 | * There isn't a variable name after all: the $ is just a $. |
---|
1531 | */ |
---|
1532 | |
---|
1533 | TclStackFree(interp, parsePtr); |
---|
1534 | return "$"; |
---|
1535 | } |
---|
1536 | |
---|
1537 | code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, |
---|
1538 | NULL, 1); |
---|
1539 | TclStackFree(interp, parsePtr); |
---|
1540 | if (code != TCL_OK) { |
---|
1541 | return NULL; |
---|
1542 | } |
---|
1543 | objPtr = Tcl_GetObjResult(interp); |
---|
1544 | |
---|
1545 | /* |
---|
1546 | * At this point we should have an object containing the value of a |
---|
1547 | * variable. Just return the string from that object. |
---|
1548 | * |
---|
1549 | * This should have returned the object for the user to manage, but |
---|
1550 | * instead we have some weak reference to the string value in the object, |
---|
1551 | * which is why we make sure the object exists after resetting the result. |
---|
1552 | * This isn't ideal, but it's the best we can do with the current |
---|
1553 | * documented interface. -- hobbs |
---|
1554 | */ |
---|
1555 | |
---|
1556 | if (!Tcl_IsShared(objPtr)) { |
---|
1557 | Tcl_IncrRefCount(objPtr); |
---|
1558 | } |
---|
1559 | Tcl_ResetResult(interp); |
---|
1560 | return TclGetString(objPtr); |
---|
1561 | } |
---|
1562 | |
---|
1563 | /* |
---|
1564 | *---------------------------------------------------------------------- |
---|
1565 | * |
---|
1566 | * Tcl_ParseBraces -- |
---|
1567 | * |
---|
1568 | * Given a string in braces such as a Tcl command argument or a string |
---|
1569 | * value in a Tcl expression, this function parses the string and returns |
---|
1570 | * information about the parse. No more than numBytes bytes will be |
---|
1571 | * scanned. |
---|
1572 | * |
---|
1573 | * Results: |
---|
1574 | * The return value is TCL_OK if the string was parsed successfully and |
---|
1575 | * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an |
---|
1576 | * error message is left in its result. On a successful return, tokenPtr |
---|
1577 | * and numTokens fields of parsePtr are filled in with information about |
---|
1578 | * the string that was parsed. Other fields in parsePtr are undefined. |
---|
1579 | * termPtr is set to point to the character just after the last one in |
---|
1580 | * the braced string. |
---|
1581 | * |
---|
1582 | * Side effects: |
---|
1583 | * If there is insufficient space in parsePtr to hold all the information |
---|
1584 | * about the command, then additional space is malloc-ed. If the function |
---|
1585 | * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to |
---|
1586 | * release any additional space that was allocated. |
---|
1587 | * |
---|
1588 | *---------------------------------------------------------------------- |
---|
1589 | */ |
---|
1590 | |
---|
1591 | int |
---|
1592 | Tcl_ParseBraces( |
---|
1593 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if |
---|
1594 | * NULL, then no error message is provided. */ |
---|
1595 | const char *start, /* Start of string enclosed in braces. The |
---|
1596 | * first character must be {'. */ |
---|
1597 | register int numBytes, /* Total number of bytes in string. If < 0, |
---|
1598 | * the string consists of all bytes up to the |
---|
1599 | * first null character. */ |
---|
1600 | register Tcl_Parse *parsePtr, |
---|
1601 | /* Structure to fill in with information about |
---|
1602 | * the string. */ |
---|
1603 | int append, /* Non-zero means append tokens to existing |
---|
1604 | * information in parsePtr; zero means ignore |
---|
1605 | * existing tokens in parsePtr and |
---|
1606 | * reinitialize it. */ |
---|
1607 | const char **termPtr) /* If non-NULL, points to word in which to |
---|
1608 | * store a pointer to the character just after |
---|
1609 | * the terminating '}' if the parse was |
---|
1610 | * successful. */ |
---|
1611 | { |
---|
1612 | Tcl_Token *tokenPtr; |
---|
1613 | register const char *src; |
---|
1614 | int startIndex, level, length; |
---|
1615 | |
---|
1616 | if ((numBytes == 0) || (start == NULL)) { |
---|
1617 | return TCL_ERROR; |
---|
1618 | } |
---|
1619 | if (numBytes < 0) { |
---|
1620 | numBytes = strlen(start); |
---|
1621 | } |
---|
1622 | |
---|
1623 | if (!append) { |
---|
1624 | TclParseInit(interp, start, numBytes, parsePtr); |
---|
1625 | } |
---|
1626 | |
---|
1627 | src = start; |
---|
1628 | startIndex = parsePtr->numTokens; |
---|
1629 | |
---|
1630 | TclGrowParseTokenArray(parsePtr, 1); |
---|
1631 | tokenPtr = &parsePtr->tokenPtr[startIndex]; |
---|
1632 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1633 | tokenPtr->start = src+1; |
---|
1634 | tokenPtr->numComponents = 0; |
---|
1635 | level = 1; |
---|
1636 | while (1) { |
---|
1637 | while (++src, --numBytes) { |
---|
1638 | if (CHAR_TYPE(*src) != TYPE_NORMAL) { |
---|
1639 | break; |
---|
1640 | } |
---|
1641 | } |
---|
1642 | if (numBytes == 0) { |
---|
1643 | goto missingBraceError; |
---|
1644 | } |
---|
1645 | |
---|
1646 | switch (*src) { |
---|
1647 | case '{': |
---|
1648 | level++; |
---|
1649 | break; |
---|
1650 | case '}': |
---|
1651 | if (--level == 0) { |
---|
1652 | /* |
---|
1653 | * Decide if we need to finish emitting a partially-finished |
---|
1654 | * token. There are 3 cases: |
---|
1655 | * {abc \newline xyz} or {xyz} |
---|
1656 | * - finish emitting "xyz" token |
---|
1657 | * {abc \newline} |
---|
1658 | * - don't emit token after \newline |
---|
1659 | * {} - finish emitting zero-sized token |
---|
1660 | * |
---|
1661 | * The last case ensures that there is a token (even if empty) |
---|
1662 | * that describes the braced string. |
---|
1663 | */ |
---|
1664 | |
---|
1665 | if ((src != tokenPtr->start) |
---|
1666 | || (parsePtr->numTokens == startIndex)) { |
---|
1667 | tokenPtr->size = (src - tokenPtr->start); |
---|
1668 | parsePtr->numTokens++; |
---|
1669 | } |
---|
1670 | if (termPtr != NULL) { |
---|
1671 | *termPtr = src+1; |
---|
1672 | } |
---|
1673 | return TCL_OK; |
---|
1674 | } |
---|
1675 | break; |
---|
1676 | case '\\': |
---|
1677 | TclParseBackslash(src, numBytes, &length, NULL); |
---|
1678 | if ((length > 1) && (src[1] == '\n')) { |
---|
1679 | /* |
---|
1680 | * A backslash-newline sequence must be collapsed, even inside |
---|
1681 | * braces, so we have to split the word into multiple tokens |
---|
1682 | * so that the backslash-newline can be represented |
---|
1683 | * explicitly. |
---|
1684 | */ |
---|
1685 | |
---|
1686 | if (numBytes == 2) { |
---|
1687 | parsePtr->incomplete = 1; |
---|
1688 | } |
---|
1689 | tokenPtr->size = (src - tokenPtr->start); |
---|
1690 | if (tokenPtr->size != 0) { |
---|
1691 | parsePtr->numTokens++; |
---|
1692 | } |
---|
1693 | TclGrowParseTokenArray(parsePtr, 2); |
---|
1694 | tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
---|
1695 | tokenPtr->type = TCL_TOKEN_BS; |
---|
1696 | tokenPtr->start = src; |
---|
1697 | tokenPtr->size = length; |
---|
1698 | tokenPtr->numComponents = 0; |
---|
1699 | parsePtr->numTokens++; |
---|
1700 | |
---|
1701 | src += length - 1; |
---|
1702 | numBytes -= length - 1; |
---|
1703 | tokenPtr++; |
---|
1704 | tokenPtr->type = TCL_TOKEN_TEXT; |
---|
1705 | tokenPtr->start = src + 1; |
---|
1706 | tokenPtr->numComponents = 0; |
---|
1707 | } else { |
---|
1708 | src += length - 1; |
---|
1709 | numBytes -= length - 1; |
---|
1710 | } |
---|
1711 | break; |
---|
1712 | } |
---|
1713 | } |
---|
1714 | |
---|
1715 | missingBraceError: |
---|
1716 | parsePtr->errorType = TCL_PARSE_MISSING_BRACE; |
---|
1717 | parsePtr->term = start; |
---|
1718 | parsePtr->incomplete = 1; |
---|
1719 | if (parsePtr->interp == NULL) { |
---|
1720 | /* |
---|
1721 | * Skip straight to the exit code since we have no interpreter to put |
---|
1722 | * error message in. |
---|
1723 | */ |
---|
1724 | |
---|
1725 | goto error; |
---|
1726 | } |
---|
1727 | |
---|
1728 | Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC); |
---|
1729 | |
---|
1730 | /* |
---|
1731 | * Guess if the problem is due to comments by searching the source string |
---|
1732 | * for a possible open brace within the context of a comment. Since we |
---|
1733 | * aren't performing a full Tcl parse, just look for an open brace |
---|
1734 | * preceded by a '<whitespace>#' on the same line. |
---|
1735 | */ |
---|
1736 | |
---|
1737 | { |
---|
1738 | register int openBrace = 0; |
---|
1739 | |
---|
1740 | while (--src > start) { |
---|
1741 | switch (*src) { |
---|
1742 | case '{': |
---|
1743 | openBrace = 1; |
---|
1744 | break; |
---|
1745 | case '\n': |
---|
1746 | openBrace = 0; |
---|
1747 | break; |
---|
1748 | case '#' : |
---|
1749 | if (openBrace && isspace(UCHAR(src[-1]))) { |
---|
1750 | Tcl_AppendResult(parsePtr->interp, |
---|
1751 | ": possible unbalanced brace in comment", NULL); |
---|
1752 | goto error; |
---|
1753 | } |
---|
1754 | break; |
---|
1755 | } |
---|
1756 | } |
---|
1757 | } |
---|
1758 | |
---|
1759 | error: |
---|
1760 | Tcl_FreeParse(parsePtr); |
---|
1761 | return TCL_ERROR; |
---|
1762 | } |
---|
1763 | |
---|
1764 | /* |
---|
1765 | *---------------------------------------------------------------------- |
---|
1766 | * |
---|
1767 | * Tcl_ParseQuotedString -- |
---|
1768 | * |
---|
1769 | * Given a double-quoted string such as a quoted Tcl command argument or |
---|
1770 | * a quoted value in a Tcl expression, this function parses the string |
---|
1771 | * and returns information about the parse. No more than numBytes bytes |
---|
1772 | * will be scanned. |
---|
1773 | * |
---|
1774 | * Results: |
---|
1775 | * The return value is TCL_OK if the string was parsed successfully and |
---|
1776 | * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then an |
---|
1777 | * error message is left in its result. On a successful return, tokenPtr |
---|
1778 | * and numTokens fields of parsePtr are filled in with information about |
---|
1779 | * the string that was parsed. Other fields in parsePtr are undefined. |
---|
1780 | * termPtr is set to point to the character just after the quoted |
---|
1781 | * string's terminating close-quote. |
---|
1782 | * |
---|
1783 | * Side effects: |
---|
1784 | * If there is insufficient space in parsePtr to hold all the information |
---|
1785 | * about the command, then additional space is malloc-ed. If the function |
---|
1786 | * returns TCL_OK then the caller must eventually invoke Tcl_FreeParse to |
---|
1787 | * release any additional space that was allocated. |
---|
1788 | * |
---|
1789 | *---------------------------------------------------------------------- |
---|
1790 | */ |
---|
1791 | |
---|
1792 | int |
---|
1793 | Tcl_ParseQuotedString( |
---|
1794 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if |
---|
1795 | * NULL, then no error message is provided. */ |
---|
1796 | const char *start, /* Start of the quoted string. The first |
---|
1797 | * character must be '"'. */ |
---|
1798 | register int numBytes, /* Total number of bytes in string. If < 0, |
---|
1799 | * the string consists of all bytes up to the |
---|
1800 | * first null character. */ |
---|
1801 | register Tcl_Parse *parsePtr, |
---|
1802 | /* Structure to fill in with information about |
---|
1803 | * the string. */ |
---|
1804 | int append, /* Non-zero means append tokens to existing |
---|
1805 | * information in parsePtr; zero means ignore |
---|
1806 | * existing tokens in parsePtr and |
---|
1807 | * reinitialize it. */ |
---|
1808 | const char **termPtr) /* If non-NULL, points to word in which to |
---|
1809 | * store a pointer to the character just after |
---|
1810 | * the quoted string's terminating close-quote |
---|
1811 | * if the parse succeeds. */ |
---|
1812 | { |
---|
1813 | if ((numBytes == 0) || (start == NULL)) { |
---|
1814 | return TCL_ERROR; |
---|
1815 | } |
---|
1816 | if (numBytes < 0) { |
---|
1817 | numBytes = strlen(start); |
---|
1818 | } |
---|
1819 | |
---|
1820 | if (!append) { |
---|
1821 | TclParseInit(interp, start, numBytes, parsePtr); |
---|
1822 | } |
---|
1823 | |
---|
1824 | if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, |
---|
1825 | parsePtr)) { |
---|
1826 | goto error; |
---|
1827 | } |
---|
1828 | if (*parsePtr->term != '"') { |
---|
1829 | if (parsePtr->interp != NULL) { |
---|
1830 | Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); |
---|
1831 | } |
---|
1832 | parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; |
---|
1833 | parsePtr->term = start; |
---|
1834 | parsePtr->incomplete = 1; |
---|
1835 | goto error; |
---|
1836 | } |
---|
1837 | if (termPtr != NULL) { |
---|
1838 | *termPtr = (parsePtr->term + 1); |
---|
1839 | } |
---|
1840 | return TCL_OK; |
---|
1841 | |
---|
1842 | error: |
---|
1843 | Tcl_FreeParse(parsePtr); |
---|
1844 | return TCL_ERROR; |
---|
1845 | } |
---|
1846 | |
---|
1847 | /* |
---|
1848 | *---------------------------------------------------------------------- |
---|
1849 | * |
---|
1850 | * Tcl_SubstObj -- |
---|
1851 | * |
---|
1852 | * This function performs the substitutions specified on the given string |
---|
1853 | * as described in the user documentation for the "subst" Tcl command. |
---|
1854 | * |
---|
1855 | * Results: |
---|
1856 | * A Tcl_Obj* containing the substituted string, or NULL to indicate that |
---|
1857 | * an error occurred. |
---|
1858 | * |
---|
1859 | * Side effects: |
---|
1860 | * See the user documentation. |
---|
1861 | * |
---|
1862 | *---------------------------------------------------------------------- |
---|
1863 | */ |
---|
1864 | |
---|
1865 | Tcl_Obj * |
---|
1866 | Tcl_SubstObj( |
---|
1867 | Tcl_Interp *interp, /* Interpreter in which substitution occurs */ |
---|
1868 | Tcl_Obj *objPtr, /* The value to be substituted. */ |
---|
1869 | int flags) /* What substitutions to do. */ |
---|
1870 | { |
---|
1871 | int length, tokensLeft, code; |
---|
1872 | Tcl_Token *endTokenPtr; |
---|
1873 | Tcl_Obj *result, *errMsg = NULL; |
---|
1874 | CONST char *p = TclGetStringFromObj(objPtr, &length); |
---|
1875 | Tcl_Parse *parsePtr = (Tcl_Parse *) |
---|
1876 | TclStackAlloc(interp, sizeof(Tcl_Parse)); |
---|
1877 | |
---|
1878 | TclParseInit(interp, p, length, parsePtr); |
---|
1879 | |
---|
1880 | /* |
---|
1881 | * First parse the string rep of objPtr, as if it were enclosed as a |
---|
1882 | * "-quoted word in a normal Tcl command. Honor flags that selectively |
---|
1883 | * inhibit types of substitution. |
---|
1884 | */ |
---|
1885 | |
---|
1886 | if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) { |
---|
1887 | /* |
---|
1888 | * There was a parse error. Save the error message for possible |
---|
1889 | * reporting later. |
---|
1890 | */ |
---|
1891 | |
---|
1892 | errMsg = Tcl_GetObjResult(interp); |
---|
1893 | Tcl_IncrRefCount(errMsg); |
---|
1894 | |
---|
1895 | /* |
---|
1896 | * We need to re-parse to get the portion of the string we can [subst] |
---|
1897 | * before the parse error. Sadly, all the Tcl_Token's created by the |
---|
1898 | * first parse attempt are gone, freed according to the public spec |
---|
1899 | * for the Tcl_Parse* routines. The only clue we have is parse.term, |
---|
1900 | * which points to either the unmatched opener, or to characters that |
---|
1901 | * follow a close brace or close quote. |
---|
1902 | * |
---|
1903 | * Call ParseTokens again, working on the string up to parse.term. |
---|
1904 | * Keep repeating until we get a good parse on a prefix. |
---|
1905 | */ |
---|
1906 | |
---|
1907 | do { |
---|
1908 | parsePtr->numTokens = 0; |
---|
1909 | parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
---|
1910 | parsePtr->end = parsePtr->term; |
---|
1911 | parsePtr->incomplete = 0; |
---|
1912 | parsePtr->errorType = TCL_PARSE_SUCCESS; |
---|
1913 | } while (TCL_OK != |
---|
1914 | ParseTokens(p, parsePtr->end - p, 0, flags, parsePtr)); |
---|
1915 | |
---|
1916 | /* |
---|
1917 | * The good parse will have to be followed by {, (, or [. |
---|
1918 | */ |
---|
1919 | |
---|
1920 | switch (*(parsePtr->term)) { |
---|
1921 | case '{': |
---|
1922 | /* |
---|
1923 | * Parse error was a missing } in a ${varname} variable |
---|
1924 | * substitution at the toplevel. We will subst everything up to |
---|
1925 | * that broken variable substitution before reporting the parse |
---|
1926 | * error. Substituting the leftover '$' will have no side-effects, |
---|
1927 | * so the current token stream is fine. |
---|
1928 | */ |
---|
1929 | break; |
---|
1930 | |
---|
1931 | case '(': |
---|
1932 | /* |
---|
1933 | * Parse error was during the parsing of the index part of an |
---|
1934 | * array variable substitution at the toplevel. |
---|
1935 | */ |
---|
1936 | |
---|
1937 | if (*(parsePtr->term - 1) == '$') { |
---|
1938 | /* |
---|
1939 | * Special case where removing the array index left us with |
---|
1940 | * just a dollar sign (array variable with name the empty |
---|
1941 | * string as its name), instead of with a scalar variable |
---|
1942 | * reference. |
---|
1943 | * |
---|
1944 | * As in the previous case, existing token stream is OK. |
---|
1945 | */ |
---|
1946 | } else { |
---|
1947 | /* |
---|
1948 | * The current parse includes a successful parse of a scalar |
---|
1949 | * variable substitution where there should have been an array |
---|
1950 | * variable substitution. We remove that mistaken part of the |
---|
1951 | * parse before moving on. A scalar variable substitution is |
---|
1952 | * two tokens. |
---|
1953 | */ |
---|
1954 | |
---|
1955 | Tcl_Token *varTokenPtr = |
---|
1956 | parsePtr->tokenPtr + parsePtr->numTokens - 2; |
---|
1957 | |
---|
1958 | if (varTokenPtr->type != TCL_TOKEN_VARIABLE) { |
---|
1959 | Tcl_Panic("Tcl_SubstObj: programming error"); |
---|
1960 | } |
---|
1961 | if (varTokenPtr[1].type != TCL_TOKEN_TEXT) { |
---|
1962 | Tcl_Panic("Tcl_SubstObj: programming error"); |
---|
1963 | } |
---|
1964 | parsePtr->numTokens -= 2; |
---|
1965 | } |
---|
1966 | break; |
---|
1967 | case '[': |
---|
1968 | /* |
---|
1969 | * Parse error occurred during parsing of a toplevel command |
---|
1970 | * substitution. |
---|
1971 | */ |
---|
1972 | |
---|
1973 | parsePtr->end = p + length; |
---|
1974 | p = parsePtr->term + 1; |
---|
1975 | length = parsePtr->end - p; |
---|
1976 | if (length == 0) { |
---|
1977 | /* |
---|
1978 | * No commands, just an unmatched [. As in previous cases, |
---|
1979 | * existing token stream is OK. |
---|
1980 | */ |
---|
1981 | } else { |
---|
1982 | /* |
---|
1983 | * We want to add the parsing of as many commands as we can |
---|
1984 | * within that substitution until we reach the actual parse |
---|
1985 | * error. We'll do additional parsing to determine what length |
---|
1986 | * to claim for the final TCL_TOKEN_COMMAND token. |
---|
1987 | */ |
---|
1988 | |
---|
1989 | Tcl_Token *tokenPtr; |
---|
1990 | const char *lastTerm = parsePtr->term; |
---|
1991 | Tcl_Parse *nestedPtr = (Tcl_Parse *) |
---|
1992 | TclStackAlloc(interp, sizeof(Tcl_Parse)); |
---|
1993 | |
---|
1994 | while (TCL_OK == |
---|
1995 | Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) { |
---|
1996 | Tcl_FreeParse(nestedPtr); |
---|
1997 | p = nestedPtr->term + (nestedPtr->term < nestedPtr->end); |
---|
1998 | length = nestedPtr->end - p; |
---|
1999 | if ((length == 0) && (nestedPtr->term == nestedPtr->end)) { |
---|
2000 | /* |
---|
2001 | * If we run out of string, blame the missing close |
---|
2002 | * bracket on the last command, and do not evaluate it |
---|
2003 | * during substitution. |
---|
2004 | */ |
---|
2005 | |
---|
2006 | break; |
---|
2007 | } |
---|
2008 | lastTerm = nestedPtr->term; |
---|
2009 | } |
---|
2010 | TclStackFree(interp, nestedPtr); |
---|
2011 | |
---|
2012 | if (lastTerm == parsePtr->term) { |
---|
2013 | /* |
---|
2014 | * Parse error in first command. No commands to subst, add |
---|
2015 | * no more tokens. |
---|
2016 | */ |
---|
2017 | break; |
---|
2018 | } |
---|
2019 | |
---|
2020 | /* |
---|
2021 | * Create a command substitution token for whatever commands |
---|
2022 | * got parsed. |
---|
2023 | */ |
---|
2024 | |
---|
2025 | TclGrowParseTokenArray(parsePtr, 1); |
---|
2026 | tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]); |
---|
2027 | tokenPtr->start = parsePtr->term; |
---|
2028 | tokenPtr->numComponents = 0; |
---|
2029 | tokenPtr->type = TCL_TOKEN_COMMAND; |
---|
2030 | tokenPtr->size = lastTerm - tokenPtr->start + 1; |
---|
2031 | parsePtr->numTokens++; |
---|
2032 | } |
---|
2033 | break; |
---|
2034 | |
---|
2035 | default: |
---|
2036 | Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]); |
---|
2037 | } |
---|
2038 | } |
---|
2039 | |
---|
2040 | /* |
---|
2041 | * Next, substitute the parsed tokens just as in normal Tcl evaluation. |
---|
2042 | */ |
---|
2043 | |
---|
2044 | endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; |
---|
2045 | tokensLeft = parsePtr->numTokens; |
---|
2046 | code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, |
---|
2047 | &tokensLeft, 1); |
---|
2048 | if (code == TCL_OK) { |
---|
2049 | Tcl_FreeParse(parsePtr); |
---|
2050 | TclStackFree(interp, parsePtr); |
---|
2051 | if (errMsg != NULL) { |
---|
2052 | Tcl_SetObjResult(interp, errMsg); |
---|
2053 | Tcl_DecrRefCount(errMsg); |
---|
2054 | return NULL; |
---|
2055 | } |
---|
2056 | return Tcl_GetObjResult(interp); |
---|
2057 | } |
---|
2058 | |
---|
2059 | result = Tcl_NewObj(); |
---|
2060 | while (1) { |
---|
2061 | switch (code) { |
---|
2062 | case TCL_ERROR: |
---|
2063 | Tcl_FreeParse(parsePtr); |
---|
2064 | TclStackFree(interp, parsePtr); |
---|
2065 | Tcl_DecrRefCount(result); |
---|
2066 | if (errMsg != NULL) { |
---|
2067 | Tcl_DecrRefCount(errMsg); |
---|
2068 | } |
---|
2069 | return NULL; |
---|
2070 | case TCL_BREAK: |
---|
2071 | tokensLeft = 0; /* Halt substitution */ |
---|
2072 | default: |
---|
2073 | Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp)); |
---|
2074 | } |
---|
2075 | |
---|
2076 | if (tokensLeft == 0) { |
---|
2077 | Tcl_FreeParse(parsePtr); |
---|
2078 | TclStackFree(interp, parsePtr); |
---|
2079 | if (errMsg != NULL) { |
---|
2080 | if (code != TCL_BREAK) { |
---|
2081 | Tcl_DecrRefCount(result); |
---|
2082 | Tcl_SetObjResult(interp, errMsg); |
---|
2083 | Tcl_DecrRefCount(errMsg); |
---|
2084 | return NULL; |
---|
2085 | } |
---|
2086 | Tcl_DecrRefCount(errMsg); |
---|
2087 | } |
---|
2088 | return result; |
---|
2089 | } |
---|
2090 | |
---|
2091 | code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, |
---|
2092 | &tokensLeft, 1); |
---|
2093 | } |
---|
2094 | } |
---|
2095 | |
---|
2096 | /* |
---|
2097 | *---------------------------------------------------------------------- |
---|
2098 | * |
---|
2099 | * TclSubstTokens -- |
---|
2100 | * |
---|
2101 | * Accepts an array of count Tcl_Token's, and creates a result value in |
---|
2102 | * the interp from concatenating the results of performing Tcl |
---|
2103 | * substitution on each Tcl_Token. Substitution is interrupted if any |
---|
2104 | * non-TCL_OK completion code arises. |
---|
2105 | * |
---|
2106 | * Results: |
---|
2107 | * The return value is a standard Tcl completion code. The result in |
---|
2108 | * interp is the substituted value, or an error message if TCL_ERROR is |
---|
2109 | * returned. If tokensLeftPtr is not NULL, then it points to an int where |
---|
2110 | * the number of tokens remaining to be processed is written. |
---|
2111 | * |
---|
2112 | * Side effects: |
---|
2113 | * Can be anything, depending on the types of substitution done. |
---|
2114 | * |
---|
2115 | *---------------------------------------------------------------------- |
---|
2116 | */ |
---|
2117 | |
---|
2118 | int |
---|
2119 | TclSubstTokens( |
---|
2120 | Tcl_Interp *interp, /* Interpreter in which to lookup variables, |
---|
2121 | * execute nested commands, and report |
---|
2122 | * errors. */ |
---|
2123 | Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to |
---|
2124 | * evaluate and concatenate. */ |
---|
2125 | int count, /* Number of tokens to consider at tokenPtr. |
---|
2126 | * Must be at least 1. */ |
---|
2127 | int *tokensLeftPtr, /* If not NULL, points to memory where an |
---|
2128 | * integer representing the number of tokens |
---|
2129 | * left to be substituted will be written */ |
---|
2130 | int line) /* The line the script starts on. */ |
---|
2131 | { |
---|
2132 | Tcl_Obj *result; |
---|
2133 | int code = TCL_OK; |
---|
2134 | |
---|
2135 | /* |
---|
2136 | * Each pass through this loop will substitute one token, and its |
---|
2137 | * components, if any. The only thing tricky here is that we go to some |
---|
2138 | * effort to pass Tcl_Obj's through untouched, to avoid string copying and |
---|
2139 | * Tcl_Obj creation if possible, to aid performance and limit shimmering. |
---|
2140 | * |
---|
2141 | * Further optimization opportunities might be to check for the equivalent |
---|
2142 | * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them. |
---|
2143 | */ |
---|
2144 | |
---|
2145 | result = NULL; |
---|
2146 | for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { |
---|
2147 | Tcl_Obj *appendObj = NULL; |
---|
2148 | const char *append = NULL; |
---|
2149 | int appendByteLength = 0; |
---|
2150 | char utfCharBytes[TCL_UTF_MAX]; |
---|
2151 | |
---|
2152 | switch (tokenPtr->type) { |
---|
2153 | case TCL_TOKEN_TEXT: |
---|
2154 | append = tokenPtr->start; |
---|
2155 | appendByteLength = tokenPtr->size; |
---|
2156 | break; |
---|
2157 | |
---|
2158 | case TCL_TOKEN_BS: |
---|
2159 | appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL, |
---|
2160 | utfCharBytes); |
---|
2161 | append = utfCharBytes; |
---|
2162 | break; |
---|
2163 | |
---|
2164 | case TCL_TOKEN_COMMAND: { |
---|
2165 | Interp *iPtr = (Interp *) interp; |
---|
2166 | |
---|
2167 | iPtr->numLevels++; |
---|
2168 | code = TclInterpReady(interp); |
---|
2169 | if (code == TCL_OK) { |
---|
2170 | /* TIP #280: Transfer line information to nested command */ |
---|
2171 | code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, |
---|
2172 | 0, line); |
---|
2173 | } |
---|
2174 | iPtr->numLevels--; |
---|
2175 | appendObj = Tcl_GetObjResult(interp); |
---|
2176 | break; |
---|
2177 | } |
---|
2178 | |
---|
2179 | case TCL_TOKEN_VARIABLE: { |
---|
2180 | Tcl_Obj *arrayIndex = NULL; |
---|
2181 | Tcl_Obj *varName = NULL; |
---|
2182 | |
---|
2183 | if (tokenPtr->numComponents > 1) { |
---|
2184 | /* |
---|
2185 | * Subst the index part of an array variable reference. |
---|
2186 | */ |
---|
2187 | |
---|
2188 | code = TclSubstTokens(interp, tokenPtr+2, |
---|
2189 | tokenPtr->numComponents - 1, NULL, line); |
---|
2190 | arrayIndex = Tcl_GetObjResult(interp); |
---|
2191 | Tcl_IncrRefCount(arrayIndex); |
---|
2192 | } |
---|
2193 | |
---|
2194 | if (code == TCL_OK) { |
---|
2195 | varName = Tcl_NewStringObj(tokenPtr[1].start, |
---|
2196 | tokenPtr[1].size); |
---|
2197 | appendObj = Tcl_ObjGetVar2(interp, varName, arrayIndex, |
---|
2198 | TCL_LEAVE_ERR_MSG); |
---|
2199 | Tcl_DecrRefCount(varName); |
---|
2200 | if (appendObj == NULL) { |
---|
2201 | code = TCL_ERROR; |
---|
2202 | } |
---|
2203 | } |
---|
2204 | |
---|
2205 | switch (code) { |
---|
2206 | case TCL_OK: /* Got value */ |
---|
2207 | case TCL_ERROR: /* Already have error message */ |
---|
2208 | case TCL_BREAK: /* Will not substitute anyway */ |
---|
2209 | case TCL_CONTINUE: /* Will not substitute anyway */ |
---|
2210 | break; |
---|
2211 | default: |
---|
2212 | /* |
---|
2213 | * All other return codes, we will subst the result from the |
---|
2214 | * code-throwing evaluation. |
---|
2215 | */ |
---|
2216 | |
---|
2217 | appendObj = Tcl_GetObjResult(interp); |
---|
2218 | } |
---|
2219 | |
---|
2220 | if (arrayIndex != NULL) { |
---|
2221 | Tcl_DecrRefCount(arrayIndex); |
---|
2222 | } |
---|
2223 | count -= tokenPtr->numComponents; |
---|
2224 | tokenPtr += tokenPtr->numComponents; |
---|
2225 | break; |
---|
2226 | } |
---|
2227 | |
---|
2228 | default: |
---|
2229 | Tcl_Panic("unexpected token type in TclSubstTokens: %d", |
---|
2230 | tokenPtr->type); |
---|
2231 | } |
---|
2232 | |
---|
2233 | if ((code == TCL_BREAK) || (code == TCL_CONTINUE)) { |
---|
2234 | /* |
---|
2235 | * Inhibit substitution. |
---|
2236 | */ |
---|
2237 | continue; |
---|
2238 | } |
---|
2239 | |
---|
2240 | if (result == NULL) { |
---|
2241 | /* |
---|
2242 | * First pass through. If we have a Tcl_Obj, just use it. If not, |
---|
2243 | * create one from our string. |
---|
2244 | */ |
---|
2245 | |
---|
2246 | if (appendObj != NULL) { |
---|
2247 | result = appendObj; |
---|
2248 | } else { |
---|
2249 | result = Tcl_NewStringObj(append, appendByteLength); |
---|
2250 | } |
---|
2251 | Tcl_IncrRefCount(result); |
---|
2252 | } else { |
---|
2253 | /* |
---|
2254 | * Subsequent passes. Append to result. |
---|
2255 | */ |
---|
2256 | |
---|
2257 | if (Tcl_IsShared(result)) { |
---|
2258 | Tcl_DecrRefCount(result); |
---|
2259 | result = Tcl_DuplicateObj(result); |
---|
2260 | Tcl_IncrRefCount(result); |
---|
2261 | } |
---|
2262 | if (appendObj != NULL) { |
---|
2263 | Tcl_AppendObjToObj(result, appendObj); |
---|
2264 | } else { |
---|
2265 | Tcl_AppendToObj(result, append, appendByteLength); |
---|
2266 | } |
---|
2267 | } |
---|
2268 | } |
---|
2269 | |
---|
2270 | if (code != TCL_ERROR) { /* Keep error message in result! */ |
---|
2271 | if (result != NULL) { |
---|
2272 | Tcl_SetObjResult(interp, result); |
---|
2273 | } else { |
---|
2274 | Tcl_ResetResult(interp); |
---|
2275 | } |
---|
2276 | } |
---|
2277 | if (tokensLeftPtr != NULL) { |
---|
2278 | *tokensLeftPtr = count; |
---|
2279 | } |
---|
2280 | if (result != NULL) { |
---|
2281 | Tcl_DecrRefCount(result); |
---|
2282 | } |
---|
2283 | return code; |
---|
2284 | } |
---|
2285 | |
---|
2286 | /* |
---|
2287 | *---------------------------------------------------------------------- |
---|
2288 | * |
---|
2289 | * CommandComplete -- |
---|
2290 | * |
---|
2291 | * This function is shared by TclCommandComplete and |
---|
2292 | * Tcl_ObjCommandComplete; it does all the real work of seeing whether a |
---|
2293 | * script is complete |
---|
2294 | * |
---|
2295 | * Results: |
---|
2296 | * 1 is returned if the script is complete, 0 if there are open |
---|
2297 | * delimiters such as " or (. 1 is also returned if there is a parse |
---|
2298 | * error in the script other than unmatched delimiters. |
---|
2299 | * |
---|
2300 | * Side effects: |
---|
2301 | * None. |
---|
2302 | * |
---|
2303 | *---------------------------------------------------------------------- |
---|
2304 | */ |
---|
2305 | |
---|
2306 | static inline int |
---|
2307 | CommandComplete( |
---|
2308 | const char *script, /* Script to check. */ |
---|
2309 | int numBytes) /* Number of bytes in script. */ |
---|
2310 | { |
---|
2311 | Tcl_Parse parse; |
---|
2312 | const char *p, *end; |
---|
2313 | int result; |
---|
2314 | |
---|
2315 | p = script; |
---|
2316 | end = p + numBytes; |
---|
2317 | while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) { |
---|
2318 | p = parse.commandStart + parse.commandSize; |
---|
2319 | if (p >= end) { |
---|
2320 | break; |
---|
2321 | } |
---|
2322 | Tcl_FreeParse(&parse); |
---|
2323 | } |
---|
2324 | if (parse.incomplete) { |
---|
2325 | result = 0; |
---|
2326 | } else { |
---|
2327 | result = 1; |
---|
2328 | } |
---|
2329 | Tcl_FreeParse(&parse); |
---|
2330 | return result; |
---|
2331 | } |
---|
2332 | |
---|
2333 | /* |
---|
2334 | *---------------------------------------------------------------------- |
---|
2335 | * |
---|
2336 | * Tcl_CommandComplete -- |
---|
2337 | * |
---|
2338 | * Given a partial or complete Tcl script, this function determines |
---|
2339 | * whether the script is complete in the sense of having matched braces |
---|
2340 | * and quotes and brackets. |
---|
2341 | * |
---|
2342 | * Results: |
---|
2343 | * 1 is returned if the script is complete, 0 otherwise. 1 is also |
---|
2344 | * returned if there is a parse error in the script other than unmatched |
---|
2345 | * delimiters. |
---|
2346 | * |
---|
2347 | * Side effects: |
---|
2348 | * None. |
---|
2349 | * |
---|
2350 | *---------------------------------------------------------------------- |
---|
2351 | */ |
---|
2352 | |
---|
2353 | int |
---|
2354 | Tcl_CommandComplete( |
---|
2355 | const char *script) /* Script to check. */ |
---|
2356 | { |
---|
2357 | return CommandComplete(script, (int) strlen(script)); |
---|
2358 | } |
---|
2359 | |
---|
2360 | /* |
---|
2361 | *---------------------------------------------------------------------- |
---|
2362 | * |
---|
2363 | * TclObjCommandComplete -- |
---|
2364 | * |
---|
2365 | * Given a partial or complete Tcl command in a Tcl object, this function |
---|
2366 | * determines whether the command is complete in the sense of having |
---|
2367 | * matched braces and quotes and brackets. |
---|
2368 | * |
---|
2369 | * Results: |
---|
2370 | * 1 is returned if the command is complete, 0 otherwise. |
---|
2371 | * |
---|
2372 | * Side effects: |
---|
2373 | * None. |
---|
2374 | * |
---|
2375 | *---------------------------------------------------------------------- |
---|
2376 | */ |
---|
2377 | |
---|
2378 | int |
---|
2379 | TclObjCommandComplete( |
---|
2380 | Tcl_Obj *objPtr) /* Points to object holding script to |
---|
2381 | * check. */ |
---|
2382 | { |
---|
2383 | int length; |
---|
2384 | const char *script = Tcl_GetStringFromObj(objPtr, &length); |
---|
2385 | |
---|
2386 | return CommandComplete(script, length); |
---|
2387 | } |
---|
2388 | |
---|
2389 | /* |
---|
2390 | *---------------------------------------------------------------------- |
---|
2391 | * |
---|
2392 | * TclIsLocalScalar -- |
---|
2393 | * |
---|
2394 | * Check to see if a given string is a legal scalar variable name with no |
---|
2395 | * namespace qualifiers or substitutions. |
---|
2396 | * |
---|
2397 | * Results: |
---|
2398 | * Returns 1 if the variable is a local scalar. |
---|
2399 | * |
---|
2400 | * Side effects: |
---|
2401 | * None. |
---|
2402 | * |
---|
2403 | *---------------------------------------------------------------------- |
---|
2404 | */ |
---|
2405 | |
---|
2406 | int |
---|
2407 | TclIsLocalScalar( |
---|
2408 | const char *src, |
---|
2409 | int len) |
---|
2410 | { |
---|
2411 | const char *p; |
---|
2412 | const char *lastChar = src + (len - 1); |
---|
2413 | |
---|
2414 | for (p=src ; p<=lastChar ; p++) { |
---|
2415 | if ((CHAR_TYPE(*p) != TYPE_NORMAL) && |
---|
2416 | (CHAR_TYPE(*p) != TYPE_COMMAND_END)) { |
---|
2417 | /* |
---|
2418 | * TCL_COMMAND_END is returned for the last character of the |
---|
2419 | * string. By this point we know it isn't an array or namespace |
---|
2420 | * reference. |
---|
2421 | */ |
---|
2422 | |
---|
2423 | return 0; |
---|
2424 | } |
---|
2425 | if (*p == '(') { |
---|
2426 | if (*lastChar == ')') { /* We have an array element */ |
---|
2427 | return 0; |
---|
2428 | } |
---|
2429 | } else if (*p == ':') { |
---|
2430 | if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ |
---|
2431 | return 0; |
---|
2432 | } |
---|
2433 | } |
---|
2434 | } |
---|
2435 | |
---|
2436 | return 1; |
---|
2437 | } |
---|
2438 | |
---|
2439 | /* |
---|
2440 | * Local Variables: |
---|
2441 | * mode: c |
---|
2442 | * c-basic-offset: 4 |
---|
2443 | * fill-column: 78 |
---|
2444 | * End: |
---|
2445 | */ |
---|