]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 5 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
ed2233dc | 9 | -- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- |
19235870 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
b5c84c3c RD |
18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | pragma Style_Checks (All_Checks); | |
27 | -- Turn off subprogram body ordering check. Subprograms are in order | |
28 | -- by RM section rather than alphabetical | |
29 | ||
30 | separate (Par) | |
31 | package body Ch5 is | |
32 | ||
33 | -- Local functions, used only in this chapter | |
34 | ||
35 | function P_Case_Statement return Node_Id; | |
36 | function P_Case_Statement_Alternative return Node_Id; | |
37 | function P_Condition return Node_Id; | |
38 | function P_Exit_Statement return Node_Id; | |
39 | function P_Goto_Statement return Node_Id; | |
40 | function P_If_Statement return Node_Id; | |
41 | function P_Label return Node_Id; | |
42 | function P_Loop_Parameter_Specification return Node_Id; | |
43 | function P_Null_Statement return Node_Id; | |
44 | ||
45 | function P_Assignment_Statement (LHS : Node_Id) return Node_Id; | |
46 | -- Parse assignment statement. On entry, the caller has scanned the left | |
47 | -- hand side (passed in as Lhs), and the colon-equal (or some symbol | |
48 | -- taken to be an error equivalent such as equal). | |
49 | ||
50 | function P_Begin_Statement (Block_Name : Node_Id := Empty) return Node_Id; | |
51 | -- Parse begin-end statement. If Block_Name is non-Empty on entry, it is | |
52 | -- the N_Identifier node for the label on the block. If Block_Name is | |
53 | -- Empty on entry (the default), then the block statement is unlabeled. | |
54 | ||
55 | function P_Declare_Statement (Block_Name : Node_Id := Empty) return Node_Id; | |
56 | -- Parse declare block. If Block_Name is non-Empty on entry, it is | |
57 | -- the N_Identifier node for the label on the block. If Block_Name is | |
58 | -- Empty on entry (the default), then the block statement is unlabeled. | |
59 | ||
60 | function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id; | |
61 | -- Parse for statement. If Loop_Name is non-Empty on entry, it is | |
62 | -- the N_Identifier node for the label on the loop. If Loop_Name is | |
63 | -- Empty on entry (the default), then the for statement is unlabeled. | |
64 | ||
65 | function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id; | |
66 | -- Parse loop statement. If Loop_Name is non-Empty on entry, it is | |
67 | -- the N_Identifier node for the label on the loop. If Loop_Name is | |
68 | -- Empty on entry (the default), then the loop statement is unlabeled. | |
69 | ||
70 | function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id; | |
71 | -- Parse while statement. If Loop_Name is non-Empty on entry, it is | |
72 | -- the N_Identifier node for the label on the loop. If Loop_Name is | |
73 | -- Empty on entry (the default), then the while statement is unlabeled. | |
74 | ||
75 | function Set_Loop_Block_Name (L : Character) return Name_Id; | |
76 | -- Given a letter 'L' for a loop or 'B' for a block, returns a name | |
77 | -- of the form L_nn or B_nn where nn is a serial number obtained by | |
78 | -- incrementing the variable Loop_Block_Count. | |
79 | ||
80 | procedure Then_Scan; | |
81 | -- Scan past THEN token, testing for illegal junk after it | |
82 | ||
83 | --------------------------------- | |
84 | -- 5.1 Sequence of Statements -- | |
85 | --------------------------------- | |
86 | ||
87 | -- SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} | |
88 | ||
89 | -- STATEMENT ::= | |
90 | -- {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT | |
91 | ||
92 | -- SIMPLE_STATEMENT ::= NULL_STATEMENT | |
93 | -- | ASSIGNMENT_STATEMENT | EXIT_STATEMENT | |
94 | -- | GOTO_STATEMENT | PROCEDURE_CALL_STATEMENT | |
95 | -- | RETURN_STATEMENT | ENTRY_CALL_STATEMENT | |
96 | -- | REQUEUE_STATEMENT | DELAY_STATEMENT | |
97 | -- | ABORT_STATEMENT | RAISE_STATEMENT | |
98 | -- | CODE_STATEMENT | |
99 | ||
100 | -- COMPOUND_STATEMENT ::= | |
101 | -- IF_STATEMENT | CASE_STATEMENT | |
102 | -- | LOOP_STATEMENT | BLOCK_STATEMENT | |
103 | -- | ACCEPT_STATEMENT | SELECT_STATEMENT | |
104 | ||
105 | -- This procedure scans a sequence of statements. The caller sets SS_Flags | |
106 | -- to indicate acceptable termination conditions for the sequence: | |
107 | ||
108 | -- SS_Flags.Eftm Terminate on ELSIF | |
109 | -- SS_Flags.Eltm Terminate on ELSE | |
110 | -- SS_Flags.Extm Terminate on EXCEPTION | |
111 | -- SS_Flags.Ortm Terminate on OR | |
112 | -- SS_Flags.Tatm Terminate on THEN ABORT (Token = ABORT on return) | |
113 | -- SS_Flags.Whtm Terminate on WHEN | |
114 | -- SS_Flags.Unco Unconditional terminate after scanning one statement | |
115 | ||
116 | -- In addition, the scan is always terminated by encountering END or the | |
117 | -- end of file (EOF) condition. If one of the six above terminators is | |
118 | -- encountered with the corresponding SS_Flags flag not set, then the | |
119 | -- action taken is as follows: | |
120 | ||
121 | -- If the keyword occurs to the left of the expected column of the end | |
122 | -- for the current sequence (as recorded in the current end context), | |
123 | -- then it is assumed to belong to an outer context, and is considered | |
124 | -- to terminate the sequence of statements. | |
125 | ||
126 | -- If the keyword occurs to the right of, or in the expected column of | |
127 | -- the end for the current sequence, then an error message is output, | |
128 | -- the keyword together with its associated context is skipped, and | |
129 | -- the statement scan continues until another terminator is found. | |
130 | ||
131 | -- Note that the first action means that control can return to the caller | |
132 | -- with Token set to a terminator other than one of those specified by the | |
133 | -- SS parameter. The caller should treat such a case as equivalent to END. | |
134 | ||
135 | -- In addition, the flag SS_Flags.Sreq is set to True to indicate that at | |
136 | -- least one real statement (other than a pragma) is required in the | |
137 | -- statement sequence. During the processing of the sequence, this | |
138 | -- flag is manipulated to indicate the current status of the requirement | |
139 | -- for a statement. For example, it is turned off by the occurrence of a | |
140 | -- statement, and back on by a label (which requires a following statement) | |
141 | ||
142 | -- Error recovery: cannot raise Error_Resync. If an error occurs during | |
143 | -- parsing a statement, then the scan pointer is advanced past the next | |
144 | -- semicolon and the parse continues. | |
145 | ||
146 | function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id is | |
147 | ||
148 | Statement_Required : Boolean; | |
149 | -- This flag indicates if a subsequent statement (other than a pragma) | |
150 | -- is required. It is initialized from the Sreq flag, and modified as | |
151 | -- statements are scanned (a statement turns it off, and a label turns | |
152 | -- it back on again since a statement must follow a label). | |
153 | ||
154 | Declaration_Found : Boolean := False; | |
155 | -- This flag is set True if a declaration is encountered, so that the | |
156 | -- error message about declarations in the statement part is only | |
157 | -- given once for a given sequence of statements. | |
158 | ||
159 | Scan_State_Label : Saved_Scan_State; | |
160 | Scan_State : Saved_Scan_State; | |
161 | ||
162 | Statement_List : List_Id; | |
163 | Block_Label : Name_Id; | |
164 | Id_Node : Node_Id; | |
165 | Name_Node : Node_Id; | |
166 | ||
167 | procedure Junk_Declaration; | |
168 | -- Procedure called to handle error of declaration encountered in | |
169 | -- statement sequence. | |
170 | ||
171 | procedure Test_Statement_Required; | |
172 | -- Flag error if Statement_Required flag set | |
173 | ||
fbf5a39b AC |
174 | ---------------------- |
175 | -- Junk_Declaration -- | |
176 | ---------------------- | |
177 | ||
19235870 RK |
178 | procedure Junk_Declaration is |
179 | begin | |
180 | if (not Declaration_Found) or All_Errors_Mode then | |
4e7a4f6e AC |
181 | Error_Msg_SC -- CODEFIX |
182 | ("declarations must come before BEGIN"); | |
19235870 RK |
183 | Declaration_Found := True; |
184 | end if; | |
185 | ||
186 | Skip_Declaration (Statement_List); | |
187 | end Junk_Declaration; | |
188 | ||
fbf5a39b AC |
189 | ----------------------------- |
190 | -- Test_Statement_Required -- | |
191 | ----------------------------- | |
192 | ||
19235870 RK |
193 | procedure Test_Statement_Required is |
194 | begin | |
195 | if Statement_Required then | |
ed2233dc AC |
196 | Error_Msg_BC -- CODEFIX |
197 | ("statement expected"); | |
19235870 RK |
198 | end if; |
199 | end Test_Statement_Required; | |
200 | ||
201 | -- Start of processing for P_Sequence_Of_Statements | |
202 | ||
203 | begin | |
204 | Statement_List := New_List; | |
205 | Statement_Required := SS_Flags.Sreq; | |
206 | ||
207 | loop | |
3b8d33ef | 208 | Ignore (Tok_Semicolon); |
19235870 RK |
209 | |
210 | begin | |
835d23b2 RD |
211 | if Style_Check then |
212 | Style.Check_Indentation; | |
213 | end if; | |
19235870 RK |
214 | |
215 | -- Deal with reserved identifier (in assignment or call) | |
216 | ||
217 | if Is_Reserved_Identifier then | |
218 | Save_Scan_State (Scan_State); -- at possible bad identifier | |
219 | Scan; -- and scan past it | |
220 | ||
221 | -- We have an reserved word which is spelled in identifier | |
222 | -- style, so the question is whether it really is intended | |
223 | -- to be an identifier. | |
224 | ||
225 | if | |
226 | -- If followed by a semicolon, then it is an identifier, | |
227 | -- with the exception of the cases tested for below. | |
228 | ||
229 | (Token = Tok_Semicolon | |
230 | and then Prev_Token /= Tok_Return | |
231 | and then Prev_Token /= Tok_Null | |
232 | and then Prev_Token /= Tok_Raise | |
233 | and then Prev_Token /= Tok_End | |
234 | and then Prev_Token /= Tok_Exit) | |
235 | ||
236 | -- If followed by colon, colon-equal, or dot, then we | |
237 | -- definitely have an identifier (could not be reserved) | |
238 | ||
239 | or else Token = Tok_Colon | |
240 | or else Token = Tok_Colon_Equal | |
241 | or else Token = Tok_Dot | |
242 | ||
243 | -- Left paren means we have an identifier except for those | |
244 | -- reserved words that can legitimately be followed by a | |
245 | -- left paren. | |
246 | ||
247 | or else | |
248 | (Token = Tok_Left_Paren | |
249 | and then Prev_Token /= Tok_Case | |
250 | and then Prev_Token /= Tok_Delay | |
251 | and then Prev_Token /= Tok_If | |
252 | and then Prev_Token /= Tok_Elsif | |
253 | and then Prev_Token /= Tok_Return | |
254 | and then Prev_Token /= Tok_When | |
255 | and then Prev_Token /= Tok_While | |
256 | and then Prev_Token /= Tok_Separate) | |
257 | then | |
258 | -- Here we have an apparent reserved identifier and the | |
259 | -- token past it is appropriate to this usage (and would | |
260 | -- be a definite error if this is not an identifier). What | |
261 | -- we do is to use P_Identifier to fix up the identifier, | |
262 | -- and then fall into the normal processing. | |
263 | ||
264 | Restore_Scan_State (Scan_State); -- back to the ID | |
265 | Scan_Reserved_Identifier (Force_Msg => False); | |
266 | ||
267 | -- Not a reserved identifier after all (or at least we can't | |
268 | -- be sure that it is), so reset the scan and continue. | |
269 | ||
270 | else | |
271 | Restore_Scan_State (Scan_State); -- back to the reserved word | |
272 | end if; | |
273 | end if; | |
274 | ||
275 | -- Now look to see what kind of statement we have | |
276 | ||
277 | case Token is | |
278 | ||
279 | -- Case of end or EOF | |
280 | ||
281 | when Tok_End | Tok_EOF => | |
282 | ||
283 | -- These tokens always terminate the statement sequence | |
284 | ||
285 | Test_Statement_Required; | |
286 | exit; | |
287 | ||
288 | -- Case of ELSIF | |
289 | ||
290 | when Tok_Elsif => | |
291 | ||
292 | -- Terminate if Eftm set or if the ELSIF is to the left | |
293 | -- of the expected column of the end for this sequence | |
294 | ||
295 | if SS_Flags.Eftm | |
296 | or else Start_Column < Scope.Table (Scope.Last).Ecol | |
297 | then | |
298 | Test_Statement_Required; | |
299 | exit; | |
300 | ||
301 | -- Otherwise complain and skip past ELSIF Condition then | |
302 | ||
303 | else | |
304 | Error_Msg_SC ("ELSIF not allowed here"); | |
305 | Scan; -- past ELSIF | |
306 | Discard_Junk_Node (P_Expression_No_Right_Paren); | |
307 | Then_Scan; | |
308 | Statement_Required := False; | |
309 | end if; | |
310 | ||
311 | -- Case of ELSE | |
312 | ||
313 | when Tok_Else => | |
314 | ||
315 | -- Terminate if Eltm set or if the else is to the left | |
316 | -- of the expected column of the end for this sequence | |
317 | ||
318 | if SS_Flags.Eltm | |
319 | or else Start_Column < Scope.Table (Scope.Last).Ecol | |
320 | then | |
321 | Test_Statement_Required; | |
322 | exit; | |
323 | ||
324 | -- Otherwise complain and skip past else | |
325 | ||
326 | else | |
327 | Error_Msg_SC ("ELSE not allowed here"); | |
328 | Scan; -- past ELSE | |
329 | Statement_Required := False; | |
330 | end if; | |
331 | ||
332 | -- Case of exception | |
333 | ||
334 | when Tok_Exception => | |
335 | Test_Statement_Required; | |
336 | ||
337 | -- If Extm not set and the exception is not to the left | |
338 | -- of the expected column of the end for this sequence, then | |
339 | -- we assume it belongs to the current sequence, even though | |
340 | -- it is not permitted. | |
341 | ||
342 | if not SS_Flags.Extm and then | |
343 | Start_Column >= Scope.Table (Scope.Last).Ecol | |
344 | ||
345 | then | |
346 | Error_Msg_SC ("exception handler not permitted here"); | |
347 | Scan; -- past EXCEPTION | |
348 | Discard_Junk_List (Parse_Exception_Handlers); | |
349 | end if; | |
350 | ||
351 | -- Always return, in the case where we scanned out handlers | |
352 | -- that we did not expect, Parse_Exception_Handlers returned | |
353 | -- with Token being either end or EOF, so we are OK | |
354 | ||
355 | exit; | |
356 | ||
357 | -- Case of OR | |
358 | ||
359 | when Tok_Or => | |
360 | ||
361 | -- Terminate if Ortm set or if the or is to the left | |
362 | -- of the expected column of the end for this sequence | |
363 | ||
364 | if SS_Flags.Ortm | |
365 | or else Start_Column < Scope.Table (Scope.Last).Ecol | |
366 | then | |
367 | Test_Statement_Required; | |
368 | exit; | |
369 | ||
370 | -- Otherwise complain and skip past or | |
371 | ||
372 | else | |
373 | Error_Msg_SC ("OR not allowed here"); | |
374 | Scan; -- past or | |
375 | Statement_Required := False; | |
376 | end if; | |
377 | ||
378 | -- Case of THEN (deal also with THEN ABORT) | |
379 | ||
380 | when Tok_Then => | |
381 | Save_Scan_State (Scan_State); -- at THEN | |
382 | Scan; -- past THEN | |
383 | ||
384 | -- Terminate if THEN ABORT allowed (ATC case) | |
385 | ||
386 | exit when SS_Flags.Tatm and then Token = Tok_Abort; | |
387 | ||
388 | -- Otherwise we treat THEN as some kind of mess where we | |
389 | -- did not see the associated IF, but we pick up assuming | |
390 | -- it had been there! | |
391 | ||
392 | Restore_Scan_State (Scan_State); -- to THEN | |
393 | Append_To (Statement_List, P_If_Statement); | |
394 | Statement_Required := False; | |
395 | ||
396 | -- Case of WHEN (error because we are not in a case) | |
397 | ||
398 | when Tok_When | Tok_Others => | |
399 | ||
400 | -- Terminate if Whtm set or if the WHEN is to the left | |
401 | -- of the expected column of the end for this sequence | |
402 | ||
403 | if SS_Flags.Whtm | |
404 | or else Start_Column < Scope.Table (Scope.Last).Ecol | |
405 | then | |
406 | Test_Statement_Required; | |
407 | exit; | |
408 | ||
409 | -- Otherwise complain and skip when Choice {| Choice} => | |
410 | ||
411 | else | |
412 | Error_Msg_SC ("WHEN not allowed here"); | |
413 | Scan; -- past when | |
414 | Discard_Junk_List (P_Discrete_Choice_List); | |
415 | TF_Arrow; | |
416 | Statement_Required := False; | |
417 | end if; | |
418 | ||
419 | -- Cases of statements starting with an identifier | |
420 | ||
421 | when Tok_Identifier => | |
422 | Check_Bad_Layout; | |
423 | ||
424 | -- Save scan pointers and line number in case block label | |
425 | ||
426 | Id_Node := Token_Node; | |
427 | Block_Label := Token_Name; | |
428 | Save_Scan_State (Scan_State_Label); -- at possible label | |
429 | Scan; -- past Id | |
430 | ||
431 | -- Check for common case of assignment, since it occurs | |
432 | -- frequently, and we want to process it efficiently. | |
433 | ||
434 | if Token = Tok_Colon_Equal then | |
435 | Scan; -- past the colon-equal | |
436 | Append_To (Statement_List, | |
437 | P_Assignment_Statement (Id_Node)); | |
438 | Statement_Required := False; | |
439 | ||
440 | -- Check common case of procedure call, another case that | |
441 | -- we want to speed up as much as possible. | |
442 | ||
443 | elsif Token = Tok_Semicolon then | |
444 | Append_To (Statement_List, | |
445 | P_Statement_Name (Id_Node)); | |
446 | Scan; -- past semicolon | |
447 | Statement_Required := False; | |
448 | ||
449 | -- Check for case of "go to" in place of "goto" | |
450 | ||
451 | elsif Token = Tok_Identifier | |
452 | and then Block_Label = Name_Go | |
453 | and then Token_Name = Name_To | |
454 | then | |
4e7a4f6e AC |
455 | Error_Msg_SP -- CODEFIX |
456 | ("goto is one word"); | |
19235870 RK |
457 | Append_To (Statement_List, P_Goto_Statement); |
458 | Statement_Required := False; | |
459 | ||
460 | -- Check common case of = used instead of :=, just so we | |
461 | -- give a better error message for this special misuse. | |
462 | ||
463 | elsif Token = Tok_Equal then | |
464 | T_Colon_Equal; -- give := expected message | |
465 | Append_To (Statement_List, | |
466 | P_Assignment_Statement (Id_Node)); | |
467 | Statement_Required := False; | |
468 | ||
469 | -- Check case of loop label or block label | |
470 | ||
471 | elsif Token = Tok_Colon | |
472 | or else (Token in Token_Class_Labeled_Stmt | |
473 | and then not Token_Is_At_Start_Of_Line) | |
474 | then | |
475 | T_Colon; -- past colon (if there, or msg for missing one) | |
476 | ||
477 | -- Test for more than one label | |
478 | ||
479 | loop | |
480 | exit when Token /= Tok_Identifier; | |
481 | Save_Scan_State (Scan_State); -- at second Id | |
482 | Scan; -- past Id | |
483 | ||
484 | if Token = Tok_Colon then | |
485 | Error_Msg_SP | |
486 | ("only one label allowed on block or loop"); | |
487 | Scan; -- past colon on extra label | |
488 | ||
489 | -- Use the second label as the "real" label | |
490 | ||
491 | Scan_State_Label := Scan_State; | |
492 | ||
493 | -- We will set Error_name as the Block_Label since | |
494 | -- we really don't know which of the labels might | |
495 | -- be used at the end of the loop or block! | |
496 | ||
497 | Block_Label := Error_Name; | |
498 | ||
499 | -- If Id with no colon, then backup to point to the | |
500 | -- Id and we will issue the message below when we try | |
501 | -- to scan out the statement as some other form. | |
502 | ||
503 | else | |
504 | Restore_Scan_State (Scan_State); -- to second Id | |
505 | exit; | |
506 | end if; | |
507 | end loop; | |
508 | ||
509 | -- Loop_Statement (labeled Loop_Statement) | |
510 | ||
511 | if Token = Tok_Loop then | |
512 | Append_To (Statement_List, | |
513 | P_Loop_Statement (Id_Node)); | |
514 | ||
515 | -- While statement (labeled loop statement with WHILE) | |
516 | ||
517 | elsif Token = Tok_While then | |
518 | Append_To (Statement_List, | |
519 | P_While_Statement (Id_Node)); | |
520 | ||
521 | -- Declare statement (labeled block statement with | |
522 | -- DECLARE part) | |
523 | ||
524 | elsif Token = Tok_Declare then | |
525 | Append_To (Statement_List, | |
526 | P_Declare_Statement (Id_Node)); | |
527 | ||
528 | -- Begin statement (labeled block statement with no | |
529 | -- DECLARE part) | |
530 | ||
531 | elsif Token = Tok_Begin then | |
532 | Append_To (Statement_List, | |
533 | P_Begin_Statement (Id_Node)); | |
534 | ||
535 | -- For statement (labeled loop statement with FOR) | |
536 | ||
537 | elsif Token = Tok_For then | |
538 | Append_To (Statement_List, | |
539 | P_For_Statement (Id_Node)); | |
540 | ||
541 | -- Improper statement follows label. If we have an | |
542 | -- expression token, then assume the colon was part | |
543 | -- of a misplaced declaration. | |
544 | ||
545 | elsif Token not in Token_Class_Eterm then | |
546 | Restore_Scan_State (Scan_State_Label); | |
547 | Junk_Declaration; | |
548 | ||
549 | -- Otherwise complain we have inappropriate statement | |
550 | ||
551 | else | |
552 | Error_Msg_AP | |
553 | ("loop or block statement must follow label"); | |
554 | end if; | |
555 | ||
556 | Statement_Required := False; | |
557 | ||
558 | -- Here we have an identifier followed by something | |
559 | -- other than a colon, semicolon or assignment symbol. | |
560 | -- The only valid possibility is a name extension symbol | |
561 | ||
562 | elsif Token in Token_Class_Namext then | |
563 | Restore_Scan_State (Scan_State_Label); -- to Id | |
564 | Name_Node := P_Name; | |
565 | ||
566 | -- Skip junk right parens in this context | |
567 | ||
3b8d33ef | 568 | Ignore (Tok_Right_Paren); |
19235870 RK |
569 | |
570 | -- Check context following call | |
571 | ||
572 | if Token = Tok_Colon_Equal then | |
573 | Scan; -- past colon equal | |
574 | Append_To (Statement_List, | |
575 | P_Assignment_Statement (Name_Node)); | |
576 | Statement_Required := False; | |
577 | ||
578 | -- Check common case of = used instead of := | |
579 | ||
580 | elsif Token = Tok_Equal then | |
581 | T_Colon_Equal; -- give := expected message | |
582 | Append_To (Statement_List, | |
583 | P_Assignment_Statement (Name_Node)); | |
584 | Statement_Required := False; | |
585 | ||
586 | -- Check apostrophe cases | |
587 | ||
588 | elsif Token = Tok_Apostrophe then | |
589 | Append_To (Statement_List, | |
590 | P_Code_Statement (Name_Node)); | |
591 | Statement_Required := False; | |
592 | ||
593 | -- The only other valid item after a name is ; which | |
594 | -- means that the item we just scanned was a call. | |
595 | ||
596 | elsif Token = Tok_Semicolon then | |
597 | Append_To (Statement_List, | |
598 | P_Statement_Name (Name_Node)); | |
599 | Scan; -- past semicolon | |
600 | Statement_Required := False; | |
601 | ||
07fc65c4 | 602 | -- A slash following an identifier or a selected |
a99ada67 RD |
603 | -- component in this situation is most likely a period |
604 | -- (see location of keys on keyboard). | |
07fc65c4 GB |
605 | |
606 | elsif Token = Tok_Slash | |
607 | and then (Nkind (Name_Node) = N_Identifier | |
608 | or else | |
609 | Nkind (Name_Node) = N_Selected_Component) | |
610 | then | |
ed2233dc AC |
611 | Error_Msg_SC -- CODEFIX |
612 | ("""/"" should be ""."""); | |
07fc65c4 GB |
613 | Statement_Required := False; |
614 | raise Error_Resync; | |
615 | ||
616 | -- Else we have a missing semicolon | |
19235870 RK |
617 | |
618 | else | |
619 | TF_Semicolon; | |
620 | Statement_Required := False; | |
621 | end if; | |
622 | ||
623 | -- If junk after identifier, check if identifier is an | |
624 | -- instance of an incorrectly spelled keyword. If so, we | |
625 | -- do nothing. The Bad_Spelling_Of will have reset Token | |
626 | -- to the appropriate keyword, so the next time round the | |
627 | -- loop we will process the modified token. Note that we | |
628 | -- check for ELSIF before ELSE here. That's not accidental. | |
629 | -- We don't want to identify a misspelling of ELSE as | |
630 | -- ELSIF, and in particular we do not want to treat ELSEIF | |
631 | -- as ELSE IF. | |
632 | ||
633 | else | |
634 | Restore_Scan_State (Scan_State_Label); -- to identifier | |
635 | ||
636 | if Bad_Spelling_Of (Tok_Abort) | |
637 | or else Bad_Spelling_Of (Tok_Accept) | |
638 | or else Bad_Spelling_Of (Tok_Case) | |
639 | or else Bad_Spelling_Of (Tok_Declare) | |
640 | or else Bad_Spelling_Of (Tok_Delay) | |
641 | or else Bad_Spelling_Of (Tok_Elsif) | |
642 | or else Bad_Spelling_Of (Tok_Else) | |
643 | or else Bad_Spelling_Of (Tok_End) | |
644 | or else Bad_Spelling_Of (Tok_Exception) | |
645 | or else Bad_Spelling_Of (Tok_Exit) | |
646 | or else Bad_Spelling_Of (Tok_For) | |
647 | or else Bad_Spelling_Of (Tok_Goto) | |
648 | or else Bad_Spelling_Of (Tok_If) | |
649 | or else Bad_Spelling_Of (Tok_Loop) | |
650 | or else Bad_Spelling_Of (Tok_Or) | |
651 | or else Bad_Spelling_Of (Tok_Pragma) | |
652 | or else Bad_Spelling_Of (Tok_Raise) | |
653 | or else Bad_Spelling_Of (Tok_Requeue) | |
654 | or else Bad_Spelling_Of (Tok_Return) | |
655 | or else Bad_Spelling_Of (Tok_Select) | |
656 | or else Bad_Spelling_Of (Tok_When) | |
657 | or else Bad_Spelling_Of (Tok_While) | |
658 | then | |
659 | null; | |
660 | ||
661 | -- If not a bad spelling, then we really have junk | |
662 | ||
663 | else | |
664 | Scan; -- past identifier again | |
665 | ||
666 | -- If next token is first token on line, then we | |
667 | -- consider that we were missing a semicolon after | |
668 | -- the identifier, and process it as a procedure | |
669 | -- call with no parameters. | |
670 | ||
671 | if Token_Is_At_Start_Of_Line then | |
672 | Append_To (Statement_List, | |
673 | P_Statement_Name (Id_Node)); | |
674 | T_Semicolon; -- to give error message | |
675 | Statement_Required := False; | |
676 | ||
677 | -- Otherwise we give a missing := message and | |
678 | -- simply abandon the junk that is there now. | |
679 | ||
680 | else | |
681 | T_Colon_Equal; -- give := expected message | |
682 | raise Error_Resync; | |
683 | end if; | |
684 | ||
685 | end if; | |
686 | end if; | |
687 | ||
688 | -- Statement starting with operator symbol. This could be | |
689 | -- a call, a name starting an assignment, or a qualified | |
690 | -- expression. | |
691 | ||
692 | when Tok_Operator_Symbol => | |
693 | Check_Bad_Layout; | |
694 | Name_Node := P_Name; | |
695 | ||
696 | -- An attempt at a range attribute or a qualified expression | |
697 | -- must be illegal here (a code statement cannot possibly | |
698 | -- allow qualification by a function name). | |
699 | ||
700 | if Token = Tok_Apostrophe then | |
701 | Error_Msg_SC ("apostrophe illegal here"); | |
702 | raise Error_Resync; | |
703 | end if; | |
704 | ||
705 | -- Scan possible assignment if we have a name | |
706 | ||
707 | if Expr_Form = EF_Name | |
708 | and then Token = Tok_Colon_Equal | |
709 | then | |
710 | Scan; -- past colon equal | |
711 | Append_To (Statement_List, | |
712 | P_Assignment_Statement (Name_Node)); | |
713 | else | |
714 | Append_To (Statement_List, | |
715 | P_Statement_Name (Name_Node)); | |
716 | end if; | |
717 | ||
718 | TF_Semicolon; | |
719 | Statement_Required := False; | |
720 | ||
721 | -- Label starting with << which must precede real statement | |
722 | ||
723 | when Tok_Less_Less => | |
724 | Append_To (Statement_List, P_Label); | |
725 | Statement_Required := True; | |
726 | ||
727 | -- Pragma appearing as a statement in a statement sequence | |
728 | ||
729 | when Tok_Pragma => | |
730 | Check_Bad_Layout; | |
731 | Append_To (Statement_List, P_Pragma); | |
732 | ||
733 | -- Abort_Statement | |
734 | ||
735 | when Tok_Abort => | |
736 | Check_Bad_Layout; | |
737 | Append_To (Statement_List, P_Abort_Statement); | |
738 | Statement_Required := False; | |
739 | ||
740 | -- Accept_Statement | |
741 | ||
742 | when Tok_Accept => | |
743 | Check_Bad_Layout; | |
744 | Append_To (Statement_List, P_Accept_Statement); | |
745 | Statement_Required := False; | |
746 | ||
747 | -- Begin_Statement (Block_Statement with no declare, no label) | |
748 | ||
749 | when Tok_Begin => | |
750 | Check_Bad_Layout; | |
751 | Append_To (Statement_List, P_Begin_Statement); | |
752 | Statement_Required := False; | |
753 | ||
754 | -- Case_Statement | |
755 | ||
756 | when Tok_Case => | |
757 | Check_Bad_Layout; | |
758 | Append_To (Statement_List, P_Case_Statement); | |
759 | Statement_Required := False; | |
760 | ||
761 | -- Block_Statement with DECLARE and no label | |
762 | ||
763 | when Tok_Declare => | |
764 | Check_Bad_Layout; | |
765 | Append_To (Statement_List, P_Declare_Statement); | |
766 | Statement_Required := False; | |
767 | ||
768 | -- Delay_Statement | |
769 | ||
770 | when Tok_Delay => | |
771 | Check_Bad_Layout; | |
772 | Append_To (Statement_List, P_Delay_Statement); | |
773 | Statement_Required := False; | |
774 | ||
775 | -- Exit_Statement | |
776 | ||
777 | when Tok_Exit => | |
778 | Check_Bad_Layout; | |
779 | Append_To (Statement_List, P_Exit_Statement); | |
780 | Statement_Required := False; | |
781 | ||
782 | -- Loop_Statement with FOR and no label | |
783 | ||
784 | when Tok_For => | |
785 | Check_Bad_Layout; | |
786 | Append_To (Statement_List, P_For_Statement); | |
787 | Statement_Required := False; | |
788 | ||
789 | -- Goto_Statement | |
790 | ||
791 | when Tok_Goto => | |
792 | Check_Bad_Layout; | |
793 | Append_To (Statement_List, P_Goto_Statement); | |
794 | Statement_Required := False; | |
795 | ||
796 | -- If_Statement | |
797 | ||
798 | when Tok_If => | |
799 | Check_Bad_Layout; | |
800 | Append_To (Statement_List, P_If_Statement); | |
801 | Statement_Required := False; | |
802 | ||
803 | -- Loop_Statement | |
804 | ||
805 | when Tok_Loop => | |
806 | Check_Bad_Layout; | |
807 | Append_To (Statement_List, P_Loop_Statement); | |
808 | Statement_Required := False; | |
809 | ||
810 | -- Null_Statement | |
811 | ||
812 | when Tok_Null => | |
813 | Check_Bad_Layout; | |
814 | Append_To (Statement_List, P_Null_Statement); | |
815 | Statement_Required := False; | |
816 | ||
817 | -- Raise_Statement | |
818 | ||
819 | when Tok_Raise => | |
820 | Check_Bad_Layout; | |
821 | Append_To (Statement_List, P_Raise_Statement); | |
822 | Statement_Required := False; | |
823 | ||
824 | -- Requeue_Statement | |
825 | ||
826 | when Tok_Requeue => | |
827 | Check_Bad_Layout; | |
828 | Append_To (Statement_List, P_Requeue_Statement); | |
829 | Statement_Required := False; | |
830 | ||
831 | -- Return_Statement | |
832 | ||
833 | when Tok_Return => | |
834 | Check_Bad_Layout; | |
835 | Append_To (Statement_List, P_Return_Statement); | |
836 | Statement_Required := False; | |
837 | ||
838 | -- Select_Statement | |
839 | ||
840 | when Tok_Select => | |
841 | Check_Bad_Layout; | |
842 | Append_To (Statement_List, P_Select_Statement); | |
843 | Statement_Required := False; | |
844 | ||
845 | -- While_Statement (Block_Statement with while and no loop) | |
846 | ||
847 | when Tok_While => | |
848 | Check_Bad_Layout; | |
849 | Append_To (Statement_List, P_While_Statement); | |
850 | Statement_Required := False; | |
851 | ||
852 | -- Anything else is some kind of junk, signal an error message | |
853 | -- and then raise Error_Resync, to merge with the normal | |
854 | -- handling of a bad statement. | |
855 | ||
856 | when others => | |
857 | ||
858 | if Token in Token_Class_Declk then | |
859 | Junk_Declaration; | |
860 | ||
861 | else | |
ed2233dc AC |
862 | Error_Msg_BC -- CODEFIX |
863 | ("statement expected"); | |
19235870 RK |
864 | raise Error_Resync; |
865 | end if; | |
866 | end case; | |
867 | ||
868 | -- On error resynchronization, skip past next semicolon, and, since | |
869 | -- we are still in the statement loop, look for next statement. We | |
870 | -- set Statement_Required False to avoid an unnecessary error message | |
871 | -- complaining that no statement was found (i.e. we consider the | |
872 | -- junk to satisfy the requirement for a statement being present). | |
873 | ||
874 | exception | |
875 | when Error_Resync => | |
876 | Resync_Past_Semicolon_Or_To_Loop_Or_Then; | |
877 | Statement_Required := False; | |
878 | end; | |
879 | ||
880 | exit when SS_Flags.Unco; | |
881 | ||
882 | end loop; | |
883 | ||
884 | return Statement_List; | |
885 | ||
886 | end P_Sequence_Of_Statements; | |
887 | ||
888 | -------------------- | |
889 | -- 5.1 Statement -- | |
890 | -------------------- | |
891 | ||
892 | -- Parsed by P_Sequence_Of_Statements (5.1), except for the case | |
893 | -- of a statement of the form of a name, which is handled here. The | |
894 | -- argument passed in is the tree for the name which has been scanned | |
895 | -- The returned value is the corresponding statement form. | |
896 | ||
897 | -- This routine is also used by Par.Prag for processing the procedure | |
898 | -- call that appears as the second argument of a pragma Assert. | |
899 | ||
900 | -- Error recovery: cannot raise Error_Resync | |
901 | ||
902 | function P_Statement_Name (Name_Node : Node_Id) return Node_Id is | |
903 | Stmt_Node : Node_Id; | |
904 | ||
905 | begin | |
906 | -- Case of Indexed component, which is a procedure call with arguments | |
907 | ||
908 | if Nkind (Name_Node) = N_Indexed_Component then | |
909 | declare | |
fbf5a39b AC |
910 | Prefix_Node : constant Node_Id := Prefix (Name_Node); |
911 | Exprs_Node : constant List_Id := Expressions (Name_Node); | |
912 | ||
19235870 RK |
913 | begin |
914 | Change_Node (Name_Node, N_Procedure_Call_Statement); | |
915 | Set_Name (Name_Node, Prefix_Node); | |
916 | Set_Parameter_Associations (Name_Node, Exprs_Node); | |
917 | return Name_Node; | |
918 | end; | |
919 | ||
920 | -- Case of function call node, which is a really a procedure call | |
921 | ||
922 | elsif Nkind (Name_Node) = N_Function_Call then | |
923 | declare | |
fbf5a39b AC |
924 | Fname_Node : constant Node_Id := Name (Name_Node); |
925 | Params_List : constant List_Id := | |
926 | Parameter_Associations (Name_Node); | |
19235870 RK |
927 | |
928 | begin | |
929 | Change_Node (Name_Node, N_Procedure_Call_Statement); | |
930 | Set_Name (Name_Node, Fname_Node); | |
931 | Set_Parameter_Associations (Name_Node, Params_List); | |
932 | return Name_Node; | |
933 | end; | |
934 | ||
935 | -- Case of call to attribute that denotes a procedure. Here we | |
936 | -- just leave the attribute reference unchanged. | |
937 | ||
938 | elsif Nkind (Name_Node) = N_Attribute_Reference | |
939 | and then Is_Procedure_Attribute_Name (Attribute_Name (Name_Node)) | |
940 | then | |
941 | return Name_Node; | |
942 | ||
943 | -- All other cases of names are parameterless procedure calls | |
944 | ||
945 | else | |
946 | Stmt_Node := | |
947 | New_Node (N_Procedure_Call_Statement, Sloc (Name_Node)); | |
948 | Set_Name (Stmt_Node, Name_Node); | |
949 | return Stmt_Node; | |
950 | end if; | |
951 | ||
952 | end P_Statement_Name; | |
953 | ||
954 | --------------------------- | |
955 | -- 5.1 Simple Statement -- | |
956 | --------------------------- | |
957 | ||
958 | -- Parsed by P_Sequence_Of_Statements (5.1) | |
959 | ||
960 | ----------------------------- | |
961 | -- 5.1 Compound Statement -- | |
962 | ----------------------------- | |
963 | ||
964 | -- Parsed by P_Sequence_Of_Statements (5.1) | |
965 | ||
966 | ------------------------- | |
967 | -- 5.1 Null Statement -- | |
968 | ------------------------- | |
969 | ||
970 | -- NULL_STATEMENT ::= null; | |
971 | ||
972 | -- The caller has already checked that the current token is null | |
973 | ||
974 | -- Error recovery: cannot raise Error_Resync | |
975 | ||
976 | function P_Null_Statement return Node_Id is | |
977 | Null_Stmt_Node : Node_Id; | |
978 | ||
979 | begin | |
980 | Null_Stmt_Node := New_Node (N_Null_Statement, Token_Ptr); | |
981 | Scan; -- past NULL | |
982 | TF_Semicolon; | |
983 | return Null_Stmt_Node; | |
984 | end P_Null_Statement; | |
985 | ||
986 | ---------------- | |
987 | -- 5.1 Label -- | |
988 | ---------------- | |
989 | ||
990 | -- LABEL ::= <<label_STATEMENT_IDENTIFIER>> | |
991 | ||
dec55d76 | 992 | -- STATEMENT_IDENTIFIER ::= DIRECT_NAME |
19235870 RK |
993 | |
994 | -- The IDENTIFIER of a STATEMENT_IDENTIFIER shall be an identifier | |
995 | -- (not an OPERATOR_SYMBOL) | |
996 | ||
997 | -- The caller has already checked that the current token is << | |
998 | ||
999 | -- Error recovery: can raise Error_Resync | |
1000 | ||
1001 | function P_Label return Node_Id is | |
1002 | Label_Node : Node_Id; | |
1003 | ||
1004 | begin | |
1005 | Label_Node := New_Node (N_Label, Token_Ptr); | |
1006 | Scan; -- past << | |
bde58e32 | 1007 | Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater)); |
19235870 RK |
1008 | T_Greater_Greater; |
1009 | Append_Elmt (Label_Node, Label_List); | |
1010 | return Label_Node; | |
1011 | end P_Label; | |
1012 | ||
1013 | ------------------------------- | |
1014 | -- 5.1 Statement Identifier -- | |
1015 | ------------------------------- | |
1016 | ||
1017 | -- Statement label is parsed by P_Label (5.1) | |
1018 | ||
1019 | -- Loop label is parsed by P_Loop_Statement (5.5), P_For_Statement (5.5) | |
1020 | -- or P_While_Statement (5.5) | |
1021 | ||
1022 | -- Block label is parsed by P_Begin_Statement (5.6) or | |
1023 | -- P_Declare_Statement (5.6) | |
1024 | ||
1025 | ------------------------------- | |
1026 | -- 5.2 Assignment Statement -- | |
1027 | ------------------------------- | |
1028 | ||
1029 | -- ASSIGNMENT_STATEMENT ::= | |
1030 | -- variable_NAME := EXPRESSION; | |
1031 | ||
1032 | -- Error recovery: can raise Error_Resync | |
1033 | ||
1034 | function P_Assignment_Statement (LHS : Node_Id) return Node_Id is | |
1035 | Assign_Node : Node_Id; | |
1036 | ||
1037 | begin | |
1038 | Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr); | |
1039 | Set_Name (Assign_Node, LHS); | |
1040 | Set_Expression (Assign_Node, P_Expression_No_Right_Paren); | |
1041 | TF_Semicolon; | |
1042 | return Assign_Node; | |
1043 | end P_Assignment_Statement; | |
1044 | ||
1045 | ----------------------- | |
1046 | -- 5.3 If Statement -- | |
1047 | ----------------------- | |
1048 | ||
1049 | -- IF_STATEMENT ::= | |
1050 | -- if CONDITION then | |
1051 | -- SEQUENCE_OF_STATEMENTS | |
1052 | -- {elsif CONDITION then | |
1053 | -- SEQUENCE_OF_STATEMENTS} | |
1054 | -- [else | |
1055 | -- SEQUENCE_OF_STATEMENTS] | |
1056 | -- end if; | |
1057 | ||
1058 | -- The caller has checked that the initial token is IF (or in the error | |
1059 | -- case of a mysterious THEN, the initial token may simply be THEN, in | |
1060 | -- which case, no condition (or IF) was scanned). | |
1061 | ||
1062 | -- Error recovery: can raise Error_Resync | |
1063 | ||
1064 | function P_If_Statement return Node_Id is | |
1065 | If_Node : Node_Id; | |
1066 | Elsif_Node : Node_Id; | |
1067 | Loc : Source_Ptr; | |
1068 | ||
1069 | procedure Add_Elsif_Part; | |
1070 | -- An internal procedure used to scan out a single ELSIF part. On entry | |
1071 | -- the ELSIF (or an ELSE which has been determined should be ELSIF) is | |
1072 | -- scanned out and is in Prev_Token. | |
1073 | ||
1074 | procedure Check_If_Column; | |
16b05213 | 1075 | -- An internal procedure used to check that THEN, ELSE, or ELSIF |
19235870 RK |
1076 | -- appear in the right place if column checking is enabled (i.e. if |
1077 | -- they are the first token on the line, then they must appear in | |
1078 | -- the same column as the opening IF). | |
1079 | ||
1080 | procedure Check_Then_Column; | |
1081 | -- This procedure carries out the style checks for a THEN token | |
1082 | -- Note that the caller has set Loc to the Source_Ptr value for | |
1083 | -- the previous IF or ELSIF token. These checks apply only to a | |
1084 | -- THEN at the start of a line. | |
1085 | ||
1086 | function Else_Should_Be_Elsif return Boolean; | |
1087 | -- An internal routine used to do a special error recovery check when | |
1088 | -- an ELSE is encountered. It determines if the ELSE should be treated | |
1089 | -- as an ELSIF. A positive decision (TRUE returned, is made if the ELSE | |
1090 | -- is followed by a sequence of tokens, starting on the same line as | |
1091 | -- the ELSE, which are not expression terminators, followed by a THEN. | |
1092 | -- On entry, the ELSE has been scanned out. | |
1093 | ||
1094 | procedure Add_Elsif_Part is | |
1095 | begin | |
1096 | if No (Elsif_Parts (If_Node)) then | |
1097 | Set_Elsif_Parts (If_Node, New_List); | |
1098 | end if; | |
1099 | ||
1100 | Elsif_Node := New_Node (N_Elsif_Part, Prev_Token_Ptr); | |
1101 | Loc := Prev_Token_Ptr; | |
1102 | Set_Condition (Elsif_Node, P_Condition); | |
1103 | Check_Then_Column; | |
1104 | Then_Scan; | |
1105 | Set_Then_Statements | |
1106 | (Elsif_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq)); | |
1107 | Append (Elsif_Node, Elsif_Parts (If_Node)); | |
1108 | end Add_Elsif_Part; | |
1109 | ||
1110 | procedure Check_If_Column is | |
1111 | begin | |
c75c4293 | 1112 | if RM_Column_Check and then Token_Is_At_Start_Of_Line |
19235870 RK |
1113 | and then Start_Column /= Scope.Table (Scope.Last).Ecol |
1114 | then | |
1115 | Error_Msg_Col := Scope.Table (Scope.Last).Ecol; | |
1116 | Error_Msg_SC ("(style) this token should be@"); | |
1117 | end if; | |
1118 | end Check_If_Column; | |
1119 | ||
1120 | procedure Check_Then_Column is | |
1121 | begin | |
1122 | if Token_Is_At_Start_Of_Line and then Token = Tok_Then then | |
1123 | Check_If_Column; | |
835d23b2 RD |
1124 | |
1125 | if Style_Check then | |
1126 | Style.Check_Then (Loc); | |
1127 | end if; | |
19235870 RK |
1128 | end if; |
1129 | end Check_Then_Column; | |
1130 | ||
1131 | function Else_Should_Be_Elsif return Boolean is | |
1132 | Scan_State : Saved_Scan_State; | |
1133 | ||
1134 | begin | |
1135 | if Token_Is_At_Start_Of_Line then | |
1136 | return False; | |
1137 | ||
1138 | else | |
1139 | Save_Scan_State (Scan_State); | |
1140 | ||
1141 | loop | |
1142 | if Token in Token_Class_Eterm then | |
1143 | Restore_Scan_State (Scan_State); | |
1144 | return False; | |
1145 | else | |
1146 | Scan; -- past non-expression terminating token | |
1147 | ||
1148 | if Token = Tok_Then then | |
1149 | Restore_Scan_State (Scan_State); | |
1150 | return True; | |
1151 | end if; | |
1152 | end if; | |
1153 | end loop; | |
1154 | end if; | |
1155 | end Else_Should_Be_Elsif; | |
1156 | ||
1157 | -- Start of processing for P_If_Statement | |
1158 | ||
1159 | begin | |
1160 | If_Node := New_Node (N_If_Statement, Token_Ptr); | |
1161 | ||
1162 | Push_Scope_Stack; | |
1163 | Scope.Table (Scope.Last).Etyp := E_If; | |
1164 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1165 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1166 | Scope.Table (Scope.Last).Labl := Error; | |
1167 | Scope.Table (Scope.Last).Node := If_Node; | |
1168 | ||
1169 | if Token = Tok_If then | |
1170 | Loc := Token_Ptr; | |
1171 | Scan; -- past IF | |
1172 | Set_Condition (If_Node, P_Condition); | |
1173 | ||
1174 | -- Deal with misuse of IF expression => used instead | |
1175 | -- of WHEN expression => | |
1176 | ||
1177 | if Token = Tok_Arrow then | |
ed2233dc AC |
1178 | Error_Msg_SC -- CODEFIX |
1179 | ("THEN expected"); | |
19235870 RK |
1180 | Scan; -- past the arrow |
1181 | Pop_Scope_Stack; -- remove unneeded entry | |
1182 | raise Error_Resync; | |
1183 | end if; | |
1184 | ||
1185 | Check_Then_Column; | |
1186 | ||
1187 | else | |
1188 | Error_Msg_SC ("no IF for this THEN"); | |
1189 | Set_Condition (If_Node, Error); | |
1190 | end if; | |
1191 | ||
1192 | Then_Scan; | |
1193 | ||
1194 | Set_Then_Statements | |
1195 | (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq)); | |
1196 | ||
1197 | -- This loop scans out else and elsif parts | |
1198 | ||
1199 | loop | |
1200 | if Token = Tok_Elsif then | |
1201 | Check_If_Column; | |
1202 | ||
1203 | if Present (Else_Statements (If_Node)) then | |
1204 | Error_Msg_SP ("ELSIF cannot appear after ELSE"); | |
1205 | end if; | |
1206 | ||
1207 | Scan; -- past ELSIF | |
1208 | Add_Elsif_Part; | |
1209 | ||
1210 | elsif Token = Tok_Else then | |
1211 | Check_If_Column; | |
1212 | Scan; -- past ELSE | |
1213 | ||
1214 | if Else_Should_Be_Elsif then | |
ed2233dc AC |
1215 | Error_Msg_SP -- CODEFIX |
1216 | ("ELSE should be ELSIF"); | |
19235870 RK |
1217 | Add_Elsif_Part; |
1218 | ||
1219 | else | |
1220 | -- Here we have an else that really is an else | |
1221 | ||
1222 | if Present (Else_Statements (If_Node)) then | |
84f8ad69 | 1223 | Error_Msg_SP ("only one ELSE part allowed"); |
19235870 RK |
1224 | Append_List |
1225 | (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq), | |
1226 | Else_Statements (If_Node)); | |
1227 | else | |
1228 | Set_Else_Statements | |
1229 | (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq)); | |
1230 | end if; | |
1231 | end if; | |
1232 | ||
1233 | -- If anything other than ELSE or ELSIF, exit the loop. The token | |
1234 | -- had better be END (and in fact it had better be END IF), but | |
1235 | -- we will let End_Statements take care of checking that. | |
1236 | ||
1237 | else | |
1238 | exit; | |
1239 | end if; | |
1240 | end loop; | |
1241 | ||
1242 | End_Statements; | |
1243 | return If_Node; | |
1244 | ||
1245 | end P_If_Statement; | |
1246 | ||
1247 | -------------------- | |
1248 | -- 5.3 Condition -- | |
1249 | -------------------- | |
1250 | ||
1251 | -- CONDITION ::= boolean_EXPRESSION | |
1252 | ||
1253 | function P_Condition return Node_Id is | |
1254 | Cond : Node_Id; | |
1255 | ||
1256 | begin | |
1257 | Cond := P_Expression_No_Right_Paren; | |
1258 | ||
1259 | -- It is never possible for := to follow a condition, so if we get | |
1260 | -- a := we assume it is a mistyped equality. Note that we do not try | |
1261 | -- to reconstruct the tree correctly in this case, but we do at least | |
1262 | -- give an accurate error message. | |
1263 | ||
fbf5a39b AC |
1264 | if Token = Tok_Colon_Equal then |
1265 | while Token = Tok_Colon_Equal loop | |
ed2233dc AC |
1266 | Error_Msg_SC -- CODEFIX |
1267 | (""":="" should be ""="""); | |
fbf5a39b AC |
1268 | Scan; -- past junk := |
1269 | Discard_Junk_Node (P_Expression_No_Right_Paren); | |
1270 | end loop; | |
1271 | ||
1272 | return Cond; | |
1273 | ||
1274 | -- Otherwise check for redundant parens | |
1275 | ||
1276 | else | |
bc202b70 | 1277 | if Style_Check |
fbf5a39b AC |
1278 | and then Paren_Count (Cond) > 0 |
1279 | then | |
bc202b70 | 1280 | Style.Check_Xtra_Parens (First_Sloc (Cond)); |
fbf5a39b AC |
1281 | end if; |
1282 | ||
1283 | -- And return the result | |
19235870 | 1284 | |
fbf5a39b AC |
1285 | return Cond; |
1286 | end if; | |
19235870 RK |
1287 | end P_Condition; |
1288 | ||
1289 | ------------------------- | |
1290 | -- 5.4 Case Statement -- | |
1291 | ------------------------- | |
1292 | ||
1293 | -- CASE_STATEMENT ::= | |
1294 | -- case EXPRESSION is | |
1295 | -- CASE_STATEMENT_ALTERNATIVE | |
1296 | -- {CASE_STATEMENT_ALTERNATIVE} | |
1297 | -- end case; | |
1298 | ||
1299 | -- The caller has checked that the first token is CASE | |
1300 | ||
1301 | -- Can raise Error_Resync | |
1302 | ||
1303 | function P_Case_Statement return Node_Id is | |
1304 | Case_Node : Node_Id; | |
1305 | Alternatives_List : List_Id; | |
1306 | First_When_Loc : Source_Ptr; | |
1307 | ||
1308 | begin | |
1309 | Case_Node := New_Node (N_Case_Statement, Token_Ptr); | |
1310 | ||
1311 | Push_Scope_Stack; | |
1312 | Scope.Table (Scope.Last).Etyp := E_Case; | |
1313 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1314 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1315 | Scope.Table (Scope.Last).Labl := Error; | |
1316 | Scope.Table (Scope.Last).Node := Case_Node; | |
1317 | ||
1318 | Scan; -- past CASE | |
1319 | Set_Expression (Case_Node, P_Expression_No_Right_Paren); | |
1320 | TF_Is; | |
1321 | ||
1322 | -- Prepare to parse case statement alternatives | |
1323 | ||
1324 | Alternatives_List := New_List; | |
1325 | P_Pragmas_Opt (Alternatives_List); | |
1326 | First_When_Loc := Token_Ptr; | |
1327 | ||
1328 | -- Loop through case statement alternatives | |
1329 | ||
1330 | loop | |
1331 | -- If we have a WHEN or OTHERS, then that's fine keep going. Note | |
1332 | -- that it is a semantic check to ensure the proper use of OTHERS | |
1333 | ||
1334 | if Token = Tok_When or else Token = Tok_Others then | |
1335 | Append (P_Case_Statement_Alternative, Alternatives_List); | |
1336 | ||
1337 | -- If we have an END, then probably we are at the end of the case | |
1338 | -- but we only exit if Check_End thinks the END was reasonable. | |
1339 | ||
1340 | elsif Token = Tok_End then | |
1341 | exit when Check_End; | |
1342 | ||
1343 | -- Here if token is other than WHEN, OTHERS or END. We definitely | |
1344 | -- have an error, but the question is whether or not to get out of | |
1345 | -- the case statement. We don't want to get out early, or we will | |
1346 | -- get a slew of junk error messages for subsequent when tokens. | |
1347 | ||
1348 | -- If the token is not at the start of the line, or if it is indented | |
1349 | -- with respect to the current case statement, then the best guess is | |
1350 | -- that we are still supposed to be inside the case statement. We | |
1351 | -- complain about the missing WHEN, and discard the junk statements. | |
1352 | ||
1353 | elsif not Token_Is_At_Start_Of_Line | |
1354 | or else Start_Column > Scope.Table (Scope.Last).Ecol | |
1355 | then | |
1356 | Error_Msg_BC ("WHEN (case statement alternative) expected"); | |
1357 | ||
1358 | -- Here is a possibility for infinite looping if we don't make | |
1359 | -- progress. So try to process statements, otherwise exit | |
1360 | ||
1361 | declare | |
1362 | Error_Ptr : constant Source_Ptr := Scan_Ptr; | |
1363 | begin | |
1364 | Discard_Junk_List (P_Sequence_Of_Statements (SS_Whtm)); | |
1365 | exit when Scan_Ptr = Error_Ptr and then Check_End; | |
1366 | end; | |
1367 | ||
1368 | -- Here we have a junk token at the start of the line and it is | |
1369 | -- not indented. If Check_End thinks there is a missing END, then | |
1370 | -- we will get out of the case, otherwise we keep going. | |
1371 | ||
1372 | else | |
1373 | exit when Check_End; | |
1374 | end if; | |
1375 | end loop; | |
1376 | ||
1377 | -- Make sure we have at least one alternative | |
1378 | ||
1379 | if No (First_Non_Pragma (Alternatives_List)) then | |
1380 | Error_Msg | |
1381 | ("WHEN expected, must have at least one alternative in case", | |
1382 | First_When_Loc); | |
1383 | return Error; | |
1384 | ||
1385 | else | |
1386 | Set_Alternatives (Case_Node, Alternatives_List); | |
1387 | return Case_Node; | |
1388 | end if; | |
1389 | end P_Case_Statement; | |
1390 | ||
1391 | ------------------------------------- | |
1392 | -- 5.4 Case Statement Alternative -- | |
1393 | ------------------------------------- | |
1394 | ||
1395 | -- CASE_STATEMENT_ALTERNATIVE ::= | |
1396 | -- when DISCRETE_CHOICE_LIST => | |
1397 | -- SEQUENCE_OF_STATEMENTS | |
1398 | ||
1399 | -- The caller has checked that the initial token is WHEN or OTHERS | |
1400 | -- Error recovery: can raise Error_Resync | |
1401 | ||
1402 | function P_Case_Statement_Alternative return Node_Id is | |
1403 | Case_Alt_Node : Node_Id; | |
1404 | ||
1405 | begin | |
835d23b2 RD |
1406 | if Style_Check then |
1407 | Style.Check_Indentation; | |
1408 | end if; | |
1409 | ||
19235870 RK |
1410 | Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr); |
1411 | T_When; -- past WHEN (or give error in OTHERS case) | |
1412 | Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List); | |
1413 | TF_Arrow; | |
1414 | Set_Statements (Case_Alt_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm)); | |
1415 | return Case_Alt_Node; | |
1416 | end P_Case_Statement_Alternative; | |
1417 | ||
1418 | ------------------------- | |
1419 | -- 5.5 Loop Statement -- | |
1420 | ------------------------- | |
1421 | ||
1422 | -- LOOP_STATEMENT ::= | |
1423 | -- [LOOP_STATEMENT_IDENTIFIER:] | |
1424 | -- [ITERATION_SCHEME] loop | |
1425 | -- SEQUENCE_OF_STATEMENTS | |
1426 | -- end loop [loop_IDENTIFIER]; | |
1427 | ||
1428 | -- ITERATION_SCHEME ::= | |
1429 | -- while CONDITION | |
1430 | -- | for LOOP_PARAMETER_SPECIFICATION | |
1431 | ||
1432 | -- The parsing of loop statements is handled by one of three functions | |
1433 | -- P_Loop_Statement, P_For_Statement or P_While_Statement depending | |
1434 | -- on the initial keyword in the construct (excluding the identifier) | |
1435 | ||
1436 | -- P_Loop_Statement | |
1437 | ||
1438 | -- This function parses the case where no iteration scheme is present | |
1439 | ||
1440 | -- The caller has checked that the initial token is LOOP. The parameter | |
1441 | -- is the node identifiers for the loop label if any (or is set to Empty | |
1442 | -- if there is no loop label). | |
1443 | ||
1444 | -- Error recovery : cannot raise Error_Resync | |
1445 | ||
1446 | function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id is | |
fbf5a39b AC |
1447 | Loop_Node : Node_Id; |
1448 | Created_Name : Node_Id; | |
19235870 RK |
1449 | |
1450 | begin | |
1451 | Push_Scope_Stack; | |
1452 | Scope.Table (Scope.Last).Labl := Loop_Name; | |
1453 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1454 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1455 | Scope.Table (Scope.Last).Etyp := E_Loop; | |
1456 | ||
1457 | Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); | |
1458 | TF_Loop; | |
1459 | ||
1460 | if No (Loop_Name) then | |
fbf5a39b AC |
1461 | Created_Name := |
1462 | Make_Identifier (Sloc (Loop_Node), | |
1463 | Chars => Set_Loop_Block_Name ('L')); | |
1464 | Set_Comes_From_Source (Created_Name, False); | |
19235870 | 1465 | Set_Has_Created_Identifier (Loop_Node, True); |
fbf5a39b AC |
1466 | Set_Identifier (Loop_Node, Created_Name); |
1467 | Scope.Table (Scope.Last).Labl := Created_Name; | |
19235870 RK |
1468 | else |
1469 | Set_Identifier (Loop_Node, Loop_Name); | |
1470 | end if; | |
1471 | ||
1472 | Append_Elmt (Loop_Node, Label_List); | |
19235870 RK |
1473 | Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq)); |
1474 | End_Statements (Loop_Node); | |
1475 | return Loop_Node; | |
1476 | end P_Loop_Statement; | |
1477 | ||
1478 | -- P_For_Statement | |
1479 | ||
1480 | -- This function parses a loop statement with a FOR iteration scheme | |
1481 | ||
1482 | -- The caller has checked that the initial token is FOR. The parameter | |
1483 | -- is the node identifier for the block label if any (or is set to Empty | |
1484 | -- if there is no block label). | |
1485 | ||
1486 | -- Note: the caller fills in the Identifier field if a label was present | |
1487 | ||
1488 | -- Error recovery: can raise Error_Resync | |
1489 | ||
1490 | function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id is | |
1491 | Loop_Node : Node_Id; | |
1492 | Iter_Scheme_Node : Node_Id; | |
1493 | Loop_For_Flag : Boolean; | |
fbf5a39b | 1494 | Created_Name : Node_Id; |
19235870 RK |
1495 | |
1496 | begin | |
1497 | Push_Scope_Stack; | |
1498 | Scope.Table (Scope.Last).Labl := Loop_Name; | |
1499 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1500 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1501 | Scope.Table (Scope.Last).Etyp := E_Loop; | |
1502 | ||
1503 | Loop_For_Flag := (Prev_Token = Tok_Loop); | |
1504 | Scan; -- past FOR | |
1505 | Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); | |
1506 | Set_Loop_Parameter_Specification | |
1507 | (Iter_Scheme_Node, P_Loop_Parameter_Specification); | |
1508 | ||
1509 | -- The following is a special test so that a miswritten for loop such | |
1510 | -- as "loop for I in 1..10;" is handled nicely, without making an extra | |
1511 | -- entry in the scope stack. We don't bother to actually fix up the | |
1512 | -- tree in this case since it's not worth the effort. Instead we just | |
1513 | -- eat up the loop junk, leaving the entry for what now looks like an | |
1514 | -- unmodified loop intact. | |
1515 | ||
1516 | if Loop_For_Flag and then Token = Tok_Semicolon then | |
1517 | Error_Msg_SC ("LOOP belongs here, not before FOR"); | |
1518 | Pop_Scope_Stack; | |
1519 | return Error; | |
1520 | ||
1521 | -- Normal case | |
1522 | ||
1523 | else | |
1524 | Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); | |
19235870 RK |
1525 | |
1526 | if No (Loop_Name) then | |
fbf5a39b AC |
1527 | Created_Name := |
1528 | Make_Identifier (Sloc (Loop_Node), | |
1529 | Chars => Set_Loop_Block_Name ('L')); | |
1530 | Set_Comes_From_Source (Created_Name, False); | |
19235870 | 1531 | Set_Has_Created_Identifier (Loop_Node, True); |
fbf5a39b AC |
1532 | Set_Identifier (Loop_Node, Created_Name); |
1533 | Scope.Table (Scope.Last).Labl := Created_Name; | |
19235870 RK |
1534 | else |
1535 | Set_Identifier (Loop_Node, Loop_Name); | |
1536 | end if; | |
1537 | ||
fbf5a39b AC |
1538 | TF_Loop; |
1539 | Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq)); | |
1540 | End_Statements (Loop_Node); | |
1541 | Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node); | |
19235870 | 1542 | Append_Elmt (Loop_Node, Label_List); |
19235870 RK |
1543 | return Loop_Node; |
1544 | end if; | |
19235870 RK |
1545 | end P_For_Statement; |
1546 | ||
1547 | -- P_While_Statement | |
1548 | ||
1549 | -- This procedure scans a loop statement with a WHILE iteration scheme | |
1550 | ||
1551 | -- The caller has checked that the initial token is WHILE. The parameter | |
1552 | -- is the node identifier for the block label if any (or is set to Empty | |
1553 | -- if there is no block label). | |
1554 | ||
1555 | -- Error recovery: cannot raise Error_Resync | |
1556 | ||
1557 | function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id is | |
1558 | Loop_Node : Node_Id; | |
1559 | Iter_Scheme_Node : Node_Id; | |
1560 | Loop_While_Flag : Boolean; | |
fbf5a39b | 1561 | Created_Name : Node_Id; |
19235870 RK |
1562 | |
1563 | begin | |
1564 | Push_Scope_Stack; | |
1565 | Scope.Table (Scope.Last).Labl := Loop_Name; | |
1566 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1567 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1568 | Scope.Table (Scope.Last).Etyp := E_Loop; | |
1569 | ||
1570 | Loop_While_Flag := (Prev_Token = Tok_Loop); | |
1571 | Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); | |
1572 | Scan; -- past WHILE | |
1573 | Set_Condition (Iter_Scheme_Node, P_Condition); | |
1574 | ||
1575 | -- The following is a special test so that a miswritten for loop such | |
1576 | -- as "loop while I > 10;" is handled nicely, without making an extra | |
1577 | -- entry in the scope stack. We don't bother to actually fix up the | |
1578 | -- tree in this case since it's not worth the effort. Instead we just | |
1579 | -- eat up the loop junk, leaving the entry for what now looks like an | |
1580 | -- unmodified loop intact. | |
1581 | ||
1582 | if Loop_While_Flag and then Token = Tok_Semicolon then | |
1583 | Error_Msg_SC ("LOOP belongs here, not before WHILE"); | |
1584 | Pop_Scope_Stack; | |
1585 | return Error; | |
1586 | ||
1587 | -- Normal case | |
1588 | ||
1589 | else | |
1590 | Loop_Node := New_Node (N_Loop_Statement, Token_Ptr); | |
1591 | TF_Loop; | |
19235870 RK |
1592 | |
1593 | if No (Loop_Name) then | |
fbf5a39b AC |
1594 | Created_Name := |
1595 | Make_Identifier (Sloc (Loop_Node), | |
1596 | Chars => Set_Loop_Block_Name ('L')); | |
1597 | Set_Comes_From_Source (Created_Name, False); | |
19235870 | 1598 | Set_Has_Created_Identifier (Loop_Node, True); |
fbf5a39b AC |
1599 | Set_Identifier (Loop_Node, Created_Name); |
1600 | Scope.Table (Scope.Last).Labl := Created_Name; | |
19235870 RK |
1601 | else |
1602 | Set_Identifier (Loop_Node, Loop_Name); | |
1603 | end if; | |
1604 | ||
fbf5a39b AC |
1605 | Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq)); |
1606 | End_Statements (Loop_Node); | |
1607 | Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node); | |
19235870 | 1608 | Append_Elmt (Loop_Node, Label_List); |
19235870 RK |
1609 | return Loop_Node; |
1610 | end if; | |
19235870 RK |
1611 | end P_While_Statement; |
1612 | ||
1613 | --------------------------------------- | |
1614 | -- 5.5 Loop Parameter Specification -- | |
1615 | --------------------------------------- | |
1616 | ||
1617 | -- LOOP_PARAMETER_SPECIFICATION ::= | |
1618 | -- DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION | |
1619 | ||
1620 | -- Error recovery: cannot raise Error_Resync | |
1621 | ||
1622 | function P_Loop_Parameter_Specification return Node_Id is | |
1623 | Loop_Param_Specification_Node : Node_Id; | |
1624 | ||
1625 | ID_Node : Node_Id; | |
1626 | Scan_State : Saved_Scan_State; | |
1627 | ||
1628 | begin | |
1629 | Loop_Param_Specification_Node := | |
1630 | New_Node (N_Loop_Parameter_Specification, Token_Ptr); | |
1631 | ||
1632 | Save_Scan_State (Scan_State); | |
bde58e32 | 1633 | ID_Node := P_Defining_Identifier (C_In); |
19235870 RK |
1634 | Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node); |
1635 | ||
1636 | if Token = Tok_Left_Paren then | |
1637 | Error_Msg_SC ("subscripted loop parameter not allowed"); | |
1638 | Restore_Scan_State (Scan_State); | |
1639 | Discard_Junk_Node (P_Name); | |
1640 | ||
1641 | elsif Token = Tok_Dot then | |
1642 | Error_Msg_SC ("selected loop parameter not allowed"); | |
1643 | Restore_Scan_State (Scan_State); | |
1644 | Discard_Junk_Node (P_Name); | |
1645 | end if; | |
1646 | ||
1647 | T_In; | |
1648 | ||
1649 | if Token = Tok_Reverse then | |
1650 | Scan; -- past REVERSE | |
1651 | Set_Reverse_Present (Loop_Param_Specification_Node, True); | |
1652 | end if; | |
1653 | ||
1654 | Set_Discrete_Subtype_Definition | |
1655 | (Loop_Param_Specification_Node, P_Discrete_Subtype_Definition); | |
1656 | return Loop_Param_Specification_Node; | |
1657 | ||
1658 | exception | |
1659 | when Error_Resync => | |
1660 | return Error; | |
1661 | end P_Loop_Parameter_Specification; | |
1662 | ||
1663 | -------------------------- | |
1664 | -- 5.6 Block Statement -- | |
1665 | -------------------------- | |
1666 | ||
1667 | -- BLOCK_STATEMENT ::= | |
1668 | -- [block_STATEMENT_IDENTIFIER:] | |
1669 | -- [declare | |
1670 | -- DECLARATIVE_PART] | |
1671 | -- begin | |
1672 | -- HANDLED_SEQUENCE_OF_STATEMENTS | |
1673 | -- end [block_IDENTIFIER]; | |
1674 | ||
1675 | -- The parsing of block statements is handled by one of the two functions | |
1676 | -- P_Declare_Statement or P_Begin_Statement depending on whether or not | |
1677 | -- a declare section is present | |
1678 | ||
1679 | -- P_Declare_Statement | |
1680 | ||
1681 | -- This function parses a block statement with DECLARE present | |
1682 | ||
9de61fcb | 1683 | -- The caller has checked that the initial token is DECLARE |
19235870 RK |
1684 | |
1685 | -- Error recovery: cannot raise Error_Resync | |
1686 | ||
1687 | function P_Declare_Statement | |
1688 | (Block_Name : Node_Id := Empty) | |
1689 | return Node_Id | |
1690 | is | |
fbf5a39b AC |
1691 | Block_Node : Node_Id; |
1692 | Created_Name : Node_Id; | |
19235870 RK |
1693 | |
1694 | begin | |
1695 | Block_Node := New_Node (N_Block_Statement, Token_Ptr); | |
1696 | ||
1697 | Push_Scope_Stack; | |
1698 | Scope.Table (Scope.Last).Etyp := E_Name; | |
1699 | Scope.Table (Scope.Last).Lreq := Present (Block_Name); | |
1700 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1701 | Scope.Table (Scope.Last).Labl := Block_Name; | |
1702 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1703 | ||
1704 | Scan; -- past DECLARE | |
1705 | ||
1706 | if No (Block_Name) then | |
fbf5a39b AC |
1707 | Created_Name := |
1708 | Make_Identifier (Sloc (Block_Node), | |
1709 | Chars => Set_Loop_Block_Name ('B')); | |
1710 | Set_Comes_From_Source (Created_Name, False); | |
19235870 | 1711 | Set_Has_Created_Identifier (Block_Node, True); |
fbf5a39b AC |
1712 | Set_Identifier (Block_Node, Created_Name); |
1713 | Scope.Table (Scope.Last).Labl := Created_Name; | |
19235870 RK |
1714 | else |
1715 | Set_Identifier (Block_Node, Block_Name); | |
1716 | end if; | |
1717 | ||
1718 | Append_Elmt (Block_Node, Label_List); | |
1719 | Parse_Decls_Begin_End (Block_Node); | |
1720 | return Block_Node; | |
1721 | end P_Declare_Statement; | |
1722 | ||
1723 | -- P_Begin_Statement | |
1724 | ||
1725 | -- This function parses a block statement with no DECLARE present | |
1726 | ||
1727 | -- The caller has checked that the initial token is BEGIN | |
1728 | ||
1729 | -- Error recovery: cannot raise Error_Resync | |
1730 | ||
1731 | function P_Begin_Statement | |
1732 | (Block_Name : Node_Id := Empty) | |
1733 | return Node_Id | |
1734 | is | |
fbf5a39b AC |
1735 | Block_Node : Node_Id; |
1736 | Created_Name : Node_Id; | |
19235870 RK |
1737 | |
1738 | begin | |
1739 | Block_Node := New_Node (N_Block_Statement, Token_Ptr); | |
1740 | ||
1741 | Push_Scope_Stack; | |
1742 | Scope.Table (Scope.Last).Etyp := E_Name; | |
1743 | Scope.Table (Scope.Last).Lreq := Present (Block_Name); | |
1744 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1745 | Scope.Table (Scope.Last).Labl := Block_Name; | |
1746 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1747 | ||
1748 | if No (Block_Name) then | |
fbf5a39b AC |
1749 | Created_Name := |
1750 | Make_Identifier (Sloc (Block_Node), | |
1751 | Chars => Set_Loop_Block_Name ('B')); | |
1752 | Set_Comes_From_Source (Created_Name, False); | |
19235870 | 1753 | Set_Has_Created_Identifier (Block_Node, True); |
fbf5a39b AC |
1754 | Set_Identifier (Block_Node, Created_Name); |
1755 | Scope.Table (Scope.Last).Labl := Created_Name; | |
19235870 RK |
1756 | else |
1757 | Set_Identifier (Block_Node, Block_Name); | |
1758 | end if; | |
1759 | ||
1760 | Append_Elmt (Block_Node, Label_List); | |
1761 | ||
1762 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
1763 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
1764 | Scan; -- past BEGIN | |
1765 | Set_Handled_Statement_Sequence | |
1766 | (Block_Node, P_Handled_Sequence_Of_Statements); | |
1767 | End_Statements (Handled_Statement_Sequence (Block_Node)); | |
1768 | return Block_Node; | |
1769 | end P_Begin_Statement; | |
1770 | ||
1771 | ------------------------- | |
1772 | -- 5.7 Exit Statement -- | |
1773 | ------------------------- | |
1774 | ||
1775 | -- EXIT_STATEMENT ::= | |
1776 | -- exit [loop_NAME] [when CONDITION]; | |
1777 | ||
1778 | -- The caller has checked that the initial token is EXIT | |
1779 | ||
1780 | -- Error recovery: can raise Error_Resync | |
1781 | ||
1782 | function P_Exit_Statement return Node_Id is | |
1783 | Exit_Node : Node_Id; | |
1784 | ||
1785 | function Missing_Semicolon_On_Exit return Boolean; | |
1786 | -- This function deals with the following specialized situation | |
1787 | -- | |
1788 | -- when 'x' => | |
1789 | -- exit [identifier] | |
1790 | -- when 'y' => | |
1791 | -- | |
1792 | -- This looks like a messed up EXIT WHEN, when in fact the problem | |
1793 | -- is a missing semicolon. It is called with Token pointing to the | |
1794 | -- WHEN token, and returns True if a semicolon is missing before | |
1795 | -- the WHEN as in the above example. | |
1796 | ||
fbf5a39b AC |
1797 | ------------------------------- |
1798 | -- Missing_Semicolon_On_Exit -- | |
1799 | ------------------------------- | |
1800 | ||
19235870 RK |
1801 | function Missing_Semicolon_On_Exit return Boolean is |
1802 | State : Saved_Scan_State; | |
1803 | ||
1804 | begin | |
1805 | if not Token_Is_At_Start_Of_Line then | |
1806 | return False; | |
1807 | ||
1808 | elsif Scope.Table (Scope.Last).Etyp /= E_Case then | |
1809 | return False; | |
1810 | ||
1811 | else | |
1812 | Save_Scan_State (State); | |
1813 | Scan; -- past WHEN | |
1814 | Scan; -- past token after WHEN | |
1815 | ||
1816 | if Token = Tok_Arrow then | |
1817 | Restore_Scan_State (State); | |
1818 | return True; | |
1819 | else | |
1820 | Restore_Scan_State (State); | |
1821 | return False; | |
1822 | end if; | |
1823 | end if; | |
1824 | end Missing_Semicolon_On_Exit; | |
1825 | ||
1826 | -- Start of processing for P_Exit_Statement | |
1827 | ||
1828 | begin | |
1829 | Exit_Node := New_Node (N_Exit_Statement, Token_Ptr); | |
1830 | Scan; -- past EXIT | |
1831 | ||
1832 | if Token = Tok_Identifier then | |
1833 | Set_Name (Exit_Node, P_Qualified_Simple_Name); | |
1834 | ||
1835 | elsif Style_Check then | |
1836 | -- This EXIT has no name, so check that | |
1837 | -- the innermost loop is unnamed too. | |
1838 | ||
1839 | Check_No_Exit_Name : | |
1840 | for J in reverse 1 .. Scope.Last loop | |
1841 | if Scope.Table (J).Etyp = E_Loop then | |
fbf5a39b AC |
1842 | if Present (Scope.Table (J).Labl) |
1843 | and then Comes_From_Source (Scope.Table (J).Labl) | |
1844 | then | |
19235870 RK |
1845 | -- Innermost loop in fact had a name, style check fails |
1846 | ||
1847 | Style.No_Exit_Name (Scope.Table (J).Labl); | |
1848 | end if; | |
1849 | ||
1850 | exit Check_No_Exit_Name; | |
1851 | end if; | |
1852 | end loop Check_No_Exit_Name; | |
1853 | end if; | |
1854 | ||
1855 | if Token = Tok_When and then not Missing_Semicolon_On_Exit then | |
1856 | Scan; -- past WHEN | |
1857 | Set_Condition (Exit_Node, P_Condition); | |
1858 | ||
1859 | -- Allow IF instead of WHEN, giving error message | |
1860 | ||
1861 | elsif Token = Tok_If then | |
1862 | T_When; | |
1863 | Scan; -- past IF used in place of WHEN | |
1864 | Set_Condition (Exit_Node, P_Expression_No_Right_Paren); | |
1865 | end if; | |
1866 | ||
1867 | TF_Semicolon; | |
1868 | return Exit_Node; | |
1869 | end P_Exit_Statement; | |
1870 | ||
1871 | ------------------------- | |
1872 | -- 5.8 Goto Statement -- | |
1873 | ------------------------- | |
1874 | ||
1875 | -- GOTO_STATEMENT ::= goto label_NAME; | |
1876 | ||
1877 | -- The caller has checked that the initial token is GOTO (or TO in the | |
1878 | -- error case where GO and TO were incorrectly separated). | |
1879 | ||
1880 | -- Error recovery: can raise Error_Resync | |
1881 | ||
1882 | function P_Goto_Statement return Node_Id is | |
1883 | Goto_Node : Node_Id; | |
1884 | ||
1885 | begin | |
1886 | Goto_Node := New_Node (N_Goto_Statement, Token_Ptr); | |
1887 | Scan; -- past GOTO (or TO) | |
1888 | Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync); | |
523456db | 1889 | Append_Elmt (Goto_Node, Goto_List); |
19235870 RK |
1890 | No_Constraint; |
1891 | TF_Semicolon; | |
1892 | return Goto_Node; | |
1893 | end P_Goto_Statement; | |
1894 | ||
1895 | --------------------------- | |
1896 | -- Parse_Decls_Begin_End -- | |
1897 | --------------------------- | |
1898 | ||
1899 | -- This function parses the construct: | |
1900 | ||
1901 | -- DECLARATIVE_PART | |
1902 | -- begin | |
1903 | -- HANDLED_SEQUENCE_OF_STATEMENTS | |
1904 | -- end [NAME]; | |
1905 | ||
1906 | -- The caller has built the scope stack entry, and created the node to | |
1907 | -- whose Declarations and Handled_Statement_Sequence fields are to be | |
1908 | -- set. On return these fields are filled in (except in the case of a | |
1909 | -- task body, where the handled statement sequence is optional, and may | |
1910 | -- thus be Empty), and the scan is positioned past the End sequence. | |
1911 | ||
1912 | -- If the BEGIN is missing, then the parent node is used to help construct | |
1913 | -- an appropriate missing BEGIN message. Possibilities for the parent are: | |
1914 | ||
1915 | -- N_Block_Statement declare block | |
1916 | -- N_Entry_Body entry body | |
1917 | -- N_Package_Body package body (begin part optional) | |
1918 | -- N_Subprogram_Body procedure or function body | |
1919 | -- N_Task_Body task body | |
1920 | ||
1921 | -- Note: in the case of a block statement, there is definitely a DECLARE | |
1922 | -- present (because a Begin statement without a DECLARE is handled by the | |
1923 | -- P_Begin_Statement procedure, which does not call Parse_Decls_Begin_End. | |
1924 | ||
1925 | -- Error recovery: cannot raise Error_Resync | |
1926 | ||
1927 | procedure Parse_Decls_Begin_End (Parent : Node_Id) is | |
1928 | Body_Decl : Node_Id; | |
1929 | Body_Sloc : Source_Ptr; | |
1930 | Decls : List_Id; | |
1931 | Decl : Node_Id; | |
1932 | Parent_Nkind : Node_Kind; | |
1933 | Spec_Node : Node_Id; | |
1934 | HSS : Node_Id; | |
1935 | ||
1936 | procedure Missing_Begin (Msg : String); | |
1937 | -- Called to post a missing begin message. In the normal case this is | |
1938 | -- posted at the start of the current token. A special case arises when | |
1939 | -- P_Declarative_Items has previously found a missing begin, in which | |
1940 | -- case we replace the original error message. | |
1941 | ||
1942 | procedure Set_Null_HSS (Parent : Node_Id); | |
1943 | -- Construct an empty handled statement sequence and install in Parent | |
1944 | -- Leaves HSS set to reference the newly constructed statement sequence. | |
1945 | ||
1946 | ------------------- | |
1947 | -- Missing_Begin -- | |
1948 | ------------------- | |
1949 | ||
1950 | procedure Missing_Begin (Msg : String) is | |
1951 | begin | |
1952 | if Missing_Begin_Msg = No_Error_Msg then | |
1953 | Error_Msg_BC (Msg); | |
1954 | else | |
1955 | Change_Error_Text (Missing_Begin_Msg, Msg); | |
1956 | ||
1957 | -- Purge any messages issued after than, since a missing begin | |
1958 | -- can cause a lot of havoc, and it is better not to dump these | |
1959 | -- cascaded messages on the user. | |
1960 | ||
1961 | Purge_Messages (Get_Location (Missing_Begin_Msg), Prev_Token_Ptr); | |
1962 | end if; | |
1963 | end Missing_Begin; | |
1964 | ||
1965 | ------------------ | |
1966 | -- Set_Null_HSS -- | |
1967 | ------------------ | |
1968 | ||
1969 | procedure Set_Null_HSS (Parent : Node_Id) is | |
1970 | Null_Stm : Node_Id; | |
1971 | ||
1972 | begin | |
1973 | Null_Stm := | |
1974 | Make_Null_Statement (Token_Ptr); | |
1975 | Set_Comes_From_Source (Null_Stm, False); | |
1976 | ||
1977 | HSS := | |
1978 | Make_Handled_Sequence_Of_Statements (Token_Ptr, | |
1979 | Statements => New_List (Null_Stm)); | |
1980 | Set_Comes_From_Source (HSS, False); | |
1981 | ||
1982 | Set_Handled_Statement_Sequence (Parent, HSS); | |
1983 | end Set_Null_HSS; | |
1984 | ||
1985 | -- Start of processing for Parse_Decls_Begin_End | |
1986 | ||
1987 | begin | |
1988 | Decls := P_Declarative_Part; | |
1989 | ||
1990 | -- Check for misplacement of later vs basic declarations in Ada 83 | |
1991 | ||
0ab80019 | 1992 | if Ada_Version = Ada_83 then |
19235870 RK |
1993 | Decl := First (Decls); |
1994 | ||
1995 | -- Loop through sequence of basic declarative items | |
1996 | ||
1997 | Outer : while Present (Decl) loop | |
1998 | if Nkind (Decl) /= N_Subprogram_Body | |
1999 | and then Nkind (Decl) /= N_Package_Body | |
2000 | and then Nkind (Decl) /= N_Task_Body | |
2001 | and then Nkind (Decl) not in N_Body_Stub | |
2002 | then | |
2003 | Next (Decl); | |
2004 | ||
2005 | -- Once a body is encountered, we only allow later declarative | |
2006 | -- items. The inner loop checks the rest of the list. | |
2007 | ||
2008 | else | |
2009 | Body_Sloc := Sloc (Decl); | |
2010 | ||
2011 | Inner : while Present (Decl) loop | |
2012 | if Nkind (Decl) not in N_Later_Decl_Item | |
2013 | and then Nkind (Decl) /= N_Pragma | |
2014 | then | |
0ab80019 | 2015 | if Ada_Version = Ada_83 then |
19235870 RK |
2016 | Error_Msg_Sloc := Body_Sloc; |
2017 | Error_Msg_N | |
2018 | ("(Ada 83) decl cannot appear after body#", Decl); | |
2019 | end if; | |
2020 | end if; | |
2021 | ||
2022 | Next (Decl); | |
2023 | end loop Inner; | |
2024 | end if; | |
2025 | end loop Outer; | |
2026 | end if; | |
2027 | ||
2028 | -- Here is where we deal with the case of IS used instead of semicolon. | |
2029 | -- Specifically, if the last declaration in the declarative part is a | |
2030 | -- subprogram body still marked as having a bad IS, then this is where | |
2031 | -- we decide that the IS should really have been a semicolon and that | |
2032 | -- the body should have been a declaration. Note that if the bad IS | |
2033 | -- had turned out to be OK (i.e. a decent begin/end was found for it), | |
2034 | -- then the Bad_Is_Detected flag would have been reset by now. | |
2035 | ||
2036 | Body_Decl := Last (Decls); | |
2037 | ||
2038 | if Present (Body_Decl) | |
2039 | and then Nkind (Body_Decl) = N_Subprogram_Body | |
2040 | and then Bad_Is_Detected (Body_Decl) | |
2041 | then | |
2042 | -- OK, we have the case of a bad IS, so we need to fix up the tree. | |
2043 | -- What we have now is a subprogram body with attached declarations | |
2044 | -- and a possible statement sequence. | |
2045 | ||
2046 | -- First step is to take the declarations that were part of the bogus | |
2047 | -- subprogram body and append them to the outer declaration chain. | |
2048 | -- In other words we append them past the body (which we will later | |
2049 | -- convert into a declaration). | |
2050 | ||
2051 | Append_List (Declarations (Body_Decl), Decls); | |
2052 | ||
2053 | -- Now take the handled statement sequence of the bogus body and | |
2054 | -- set it as the statement sequence for the outer construct. Note | |
2055 | -- that it may be empty (we specially allowed a missing BEGIN for | |
2056 | -- a subprogram body marked as having a bad IS -- see below). | |
2057 | ||
2058 | Set_Handled_Statement_Sequence (Parent, | |
2059 | Handled_Statement_Sequence (Body_Decl)); | |
2060 | ||
2061 | -- Next step is to convert the old body node to a declaration node | |
2062 | ||
2063 | Spec_Node := Specification (Body_Decl); | |
2064 | Change_Node (Body_Decl, N_Subprogram_Declaration); | |
2065 | Set_Specification (Body_Decl, Spec_Node); | |
2066 | ||
2067 | -- Final step is to put the declarations for the parent where | |
2068 | -- they belong, and then fall through the IF to scan out the | |
2069 | -- END statements. | |
2070 | ||
2071 | Set_Declarations (Parent, Decls); | |
2072 | ||
2073 | -- This is the normal case (i.e. any case except the bad IS case) | |
2074 | -- If we have a BEGIN, then scan out the sequence of statements, and | |
2075 | -- also reset the expected column for the END to match the BEGIN. | |
2076 | ||
2077 | else | |
2078 | Set_Declarations (Parent, Decls); | |
2079 | ||
2080 | if Token = Tok_Begin then | |
835d23b2 RD |
2081 | if Style_Check then |
2082 | Style.Check_Indentation; | |
2083 | end if; | |
19235870 RK |
2084 | |
2085 | Error_Msg_Col := Scope.Table (Scope.Last).Ecol; | |
2086 | ||
c75c4293 | 2087 | if RM_Column_Check |
19235870 RK |
2088 | and then Token_Is_At_Start_Of_Line |
2089 | and then Start_Column /= Error_Msg_Col | |
2090 | then | |
2091 | Error_Msg_SC ("(style) BEGIN in wrong column, should be@"); | |
2092 | ||
2093 | else | |
2094 | Scope.Table (Scope.Last).Ecol := Start_Column; | |
2095 | end if; | |
2096 | ||
2097 | Scope.Table (Scope.Last).Sloc := Token_Ptr; | |
2098 | Scan; -- past BEGIN | |
2099 | Set_Handled_Statement_Sequence (Parent, | |
2100 | P_Handled_Sequence_Of_Statements); | |
2101 | ||
2102 | -- No BEGIN present | |
2103 | ||
2104 | else | |
2105 | Parent_Nkind := Nkind (Parent); | |
2106 | ||
2107 | -- A special check for the missing IS case. If we have a | |
2108 | -- subprogram body that was marked as having a suspicious | |
2109 | -- IS, and the current token is END, then we simply confirm | |
2110 | -- the suspicion, and do not require a BEGIN to be present | |
2111 | ||
2112 | if Parent_Nkind = N_Subprogram_Body | |
2113 | and then Token = Tok_End | |
2114 | and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is | |
2115 | then | |
2116 | Scope.Table (Scope.Last).Etyp := E_Bad_Is; | |
2117 | ||
2118 | -- Otherwise BEGIN is not required for a package body, so we | |
2119 | -- don't mind if it is missing, but we do construct a dummy | |
2120 | -- one (so that we have somewhere to set End_Label). | |
2121 | ||
2122 | -- However if we have something other than a BEGIN which | |
2123 | -- looks like it might be statements, then we signal a missing | |
2124 | -- BEGIN for these cases as well. We define "something which | |
2125 | -- looks like it might be statements" as a token other than | |
2126 | -- END, EOF, or a token which starts declarations. | |
2127 | ||
2128 | elsif Parent_Nkind = N_Package_Body | |
2129 | and then (Token = Tok_End | |
2130 | or else Token = Tok_EOF | |
2131 | or else Token in Token_Class_Declk) | |
2132 | then | |
2133 | Set_Null_HSS (Parent); | |
2134 | ||
2135 | -- These are cases in which a BEGIN is required and not present | |
2136 | ||
2137 | else | |
2138 | Set_Null_HSS (Parent); | |
2139 | ||
2140 | -- Prepare to issue error message | |
2141 | ||
2142 | Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc; | |
2143 | Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl; | |
2144 | ||
2145 | -- Now issue appropriate message | |
2146 | ||
2147 | if Parent_Nkind = N_Block_Statement then | |
2148 | Missing_Begin ("missing BEGIN for DECLARE#!"); | |
2149 | ||
2150 | elsif Parent_Nkind = N_Entry_Body then | |
2151 | Missing_Begin ("missing BEGIN for ENTRY#!"); | |
2152 | ||
2153 | elsif Parent_Nkind = N_Subprogram_Body then | |
2154 | if Nkind (Specification (Parent)) | |
2155 | = N_Function_Specification | |
2156 | then | |
2157 | Missing_Begin ("missing BEGIN for function&#!"); | |
2158 | else | |
2159 | Missing_Begin ("missing BEGIN for procedure&#!"); | |
2160 | end if; | |
2161 | ||
2162 | -- The case for package body arises only when | |
2163 | -- we have possible statement junk present. | |
2164 | ||
2165 | elsif Parent_Nkind = N_Package_Body then | |
2166 | Missing_Begin ("missing BEGIN for package body&#!"); | |
2167 | ||
2168 | else | |
2169 | pragma Assert (Parent_Nkind = N_Task_Body); | |
2170 | Missing_Begin ("missing BEGIN for task body&#!"); | |
2171 | end if; | |
2172 | ||
2173 | -- Here we pick up the statements after the BEGIN that | |
2174 | -- should have been present but was not. We don't insist | |
2175 | -- on statements being present if P_Declarative_Part had | |
2176 | -- already found a missing BEGIN, since it might have | |
2177 | -- swallowed a lone statement into the declarative part. | |
2178 | ||
2179 | if Missing_Begin_Msg /= No_Error_Msg | |
2180 | and then Token = Tok_End | |
2181 | then | |
2182 | null; | |
2183 | else | |
2184 | Set_Handled_Statement_Sequence (Parent, | |
2185 | P_Handled_Sequence_Of_Statements); | |
2186 | end if; | |
2187 | end if; | |
2188 | end if; | |
2189 | end if; | |
2190 | ||
2191 | -- Here with declarations and handled statement sequence scanned | |
2192 | ||
2193 | if Present (Handled_Statement_Sequence (Parent)) then | |
2194 | End_Statements (Handled_Statement_Sequence (Parent)); | |
2195 | else | |
2196 | End_Statements; | |
2197 | end if; | |
2198 | ||
2199 | -- We know that End_Statements removed an entry from the scope stack | |
2200 | -- (because it is required to do so under all circumstances). We can | |
2201 | -- therefore reference the entry it removed one past the stack top. | |
2202 | -- What we are interested in is whether it was a case of a bad IS. | |
2203 | ||
2204 | if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then | |
ed2233dc AC |
2205 | Error_Msg -- CODEFIX |
2206 | ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is); | |
19235870 RK |
2207 | Set_Bad_Is_Detected (Parent, True); |
2208 | end if; | |
2209 | ||
2210 | end Parse_Decls_Begin_End; | |
2211 | ||
2212 | ------------------------- | |
2213 | -- Set_Loop_Block_Name -- | |
2214 | ------------------------- | |
2215 | ||
2216 | function Set_Loop_Block_Name (L : Character) return Name_Id is | |
2217 | begin | |
2218 | Name_Buffer (1) := L; | |
2219 | Name_Buffer (2) := '_'; | |
2220 | Name_Len := 2; | |
2221 | Loop_Block_Count := Loop_Block_Count + 1; | |
2222 | Add_Nat_To_Name_Buffer (Loop_Block_Count); | |
2223 | return Name_Find; | |
2224 | end Set_Loop_Block_Name; | |
2225 | ||
2226 | --------------- | |
2227 | -- Then_Scan -- | |
2228 | --------------- | |
2229 | ||
2230 | procedure Then_Scan is | |
2231 | begin | |
2232 | TF_Then; | |
2233 | ||
2234 | while Token = Tok_Then loop | |
ed2233dc AC |
2235 | Error_Msg_SC -- CODEFIX |
2236 | ("redundant THEN"); | |
19235870 RK |
2237 | TF_Then; |
2238 | end loop; | |
2239 | ||
2240 | if Token = Tok_And or else Token = Tok_Or then | |
2241 | Error_Msg_SC ("unexpected logical operator"); | |
3b8d33ef | 2242 | Scan; -- past logical operator |
19235870 RK |
2243 | |
2244 | if (Prev_Token = Tok_And and then Token = Tok_Then) | |
2245 | or else | |
2246 | (Prev_Token = Tok_Or and then Token = Tok_Else) | |
2247 | then | |
2248 | Scan; | |
2249 | end if; | |
2250 | ||
2251 | Discard_Junk_Node (P_Expression); | |
2252 | end if; | |
2253 | ||
2254 | if Token = Tok_Then then | |
2255 | Scan; | |
2256 | end if; | |
2257 | end Then_Scan; | |
2258 | ||
2259 | end Ch5; |