1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
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- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
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 --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
33 -- Local functions, used only in this chapter
35 function P_Case_Statement return Node_Id;
36 function P_Case_Statement_Alternative return Node_Id;
37 function P_Exit_Statement return Node_Id;
38 function P_Goto_Statement return Node_Id;
39 function P_If_Statement return Node_Id;
40 function P_Label return Node_Id;
41 function P_Null_Statement return Node_Id;
43 function P_Assignment_Statement (LHS : Node_Id) return Node_Id;
44 -- Parse assignment statement. On entry, the caller has scanned the left
45 -- hand side (passed in as Lhs), and the colon-equal (or some symbol
46 -- taken to be an error equivalent such as equal).
48 function P_Begin_Statement (Block_Name : Node_Id := Empty) return Node_Id;
49 -- Parse begin-end statement. If Block_Name is non-Empty on entry, it is
50 -- the N_Identifier node for the label on the block. If Block_Name is
51 -- Empty on entry (the default), then the block statement is unlabeled.
53 function P_Declare_Statement (Block_Name : Node_Id := Empty) return Node_Id;
54 -- Parse declare block. If Block_Name is non-Empty on entry, it is
55 -- the N_Identifier node for the label on the block. If Block_Name is
56 -- Empty on entry (the default), then the block statement is unlabeled.
58 function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
59 -- Parse for statement. If Loop_Name is non-Empty on entry, it is
60 -- the N_Identifier node for the label on the loop. If Loop_Name is
61 -- Empty on entry (the default), then the for statement is unlabeled.
63 function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
64 -- Parse an iterator specification. The defining identifier has already
65 -- been scanned, as it is the common prefix between loop and iterator
68 function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
69 -- Parse loop statement. If Loop_Name is non-Empty on entry, it is
70 -- the N_Identifier node for the label on the loop. If Loop_Name is
71 -- Empty on entry (the default), then the loop statement is unlabeled.
73 function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
74 -- Parse while statement. If Loop_Name is non-Empty on entry, it is
75 -- the N_Identifier node for the label on the loop. If Loop_Name is
76 -- Empty on entry (the default), then the while statement is unlabeled.
78 function Set_Loop_Block_Name (L : Character) return Name_Id;
79 -- Given a letter 'L' for a loop or 'B' for a block, returns a name
80 -- of the form L_nn or B_nn where nn is a serial number obtained by
81 -- incrementing the variable Loop_Block_Count.
84 -- Scan past THEN token, testing for illegal junk after it
86 ---------------------------------
87 -- 5.1 Sequence of Statements --
88 ---------------------------------
90 -- SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
91 -- Note: the final label is an Ada 2012 addition.
94 -- {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
96 -- SIMPLE_STATEMENT ::= NULL_STATEMENT
97 -- | ASSIGNMENT_STATEMENT | EXIT_STATEMENT
98 -- | GOTO_STATEMENT | PROCEDURE_CALL_STATEMENT
99 -- | RETURN_STATEMENT | ENTRY_CALL_STATEMENT
100 -- | REQUEUE_STATEMENT | DELAY_STATEMENT
101 -- | ABORT_STATEMENT | RAISE_STATEMENT
104 -- COMPOUND_STATEMENT ::=
105 -- IF_STATEMENT | CASE_STATEMENT
106 -- | LOOP_STATEMENT | BLOCK_STATEMENT
107 -- | ACCEPT_STATEMENT | SELECT_STATEMENT
109 -- This procedure scans a sequence of statements. The caller sets SS_Flags
110 -- to indicate acceptable termination conditions for the sequence:
112 -- SS_Flags.Eftm Terminate on ELSIF
113 -- SS_Flags.Eltm Terminate on ELSE
114 -- SS_Flags.Extm Terminate on EXCEPTION
115 -- SS_Flags.Ortm Terminate on OR
116 -- SS_Flags.Tatm Terminate on THEN ABORT (Token = ABORT on return)
117 -- SS_Flags.Whtm Terminate on WHEN
118 -- SS_Flags.Unco Unconditional terminate after scanning one statement
120 -- In addition, the scan is always terminated by encountering END or the
121 -- end of file (EOF) condition. If one of the six above terminators is
122 -- encountered with the corresponding SS_Flags flag not set, then the
123 -- action taken is as follows:
125 -- If the keyword occurs to the left of the expected column of the end
126 -- for the current sequence (as recorded in the current end context),
127 -- then it is assumed to belong to an outer context, and is considered
128 -- to terminate the sequence of statements.
130 -- If the keyword occurs to the right of, or in the expected column of
131 -- the end for the current sequence, then an error message is output,
132 -- the keyword together with its associated context is skipped, and
133 -- the statement scan continues until another terminator is found.
135 -- Note that the first action means that control can return to the caller
136 -- with Token set to a terminator other than one of those specified by the
137 -- SS parameter. The caller should treat such a case as equivalent to END.
139 -- In addition, the flag SS_Flags.Sreq is set to True to indicate that at
140 -- least one real statement (other than a pragma) is required in the
141 -- statement sequence. During the processing of the sequence, this
142 -- flag is manipulated to indicate the current status of the requirement
143 -- for a statement. For example, it is turned off by the occurrence of a
144 -- statement, and back on by a label (which requires a following statement)
146 -- Error recovery: cannot raise Error_Resync. If an error occurs during
147 -- parsing a statement, then the scan pointer is advanced past the next
148 -- semicolon and the parse continues.
150 function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id is
152 Statement_Required : Boolean;
153 -- This flag indicates if a subsequent statement (other than a pragma)
154 -- is required. It is initialized from the Sreq flag, and modified as
155 -- statements are scanned (a statement turns it off, and a label turns
156 -- it back on again since a statement must follow a label).
157 -- Note : this final requirement is lifted in Ada 2012.
159 Statement_Seen : Boolean;
160 -- In Ada 2012, a label can end a sequence of statements, but the
161 -- sequence cannot contain only labels. This flag is set whenever a
162 -- label is encountered, to enforce this rule at the end of a sequence.
164 Declaration_Found : Boolean := False;
165 -- This flag is set True if a declaration is encountered, so that the
166 -- error message about declarations in the statement part is only
167 -- given once for a given sequence of statements.
169 Scan_State_Label : Saved_Scan_State;
170 Scan_State : Saved_Scan_State;
172 Statement_List : List_Id;
173 Block_Label : Name_Id;
177 procedure Junk_Declaration;
178 -- Procedure called to handle error of declaration encountered in
179 -- statement sequence.
181 procedure Test_Statement_Required;
182 -- Flag error if Statement_Required flag set
184 ----------------------
185 -- Junk_Declaration --
186 ----------------------
188 procedure Junk_Declaration is
190 if (not Declaration_Found) or All_Errors_Mode then
191 Error_Msg_SC -- CODEFIX
192 ("declarations must come before BEGIN");
193 Declaration_Found := True;
196 Skip_Declaration (Statement_List);
197 end Junk_Declaration;
199 -----------------------------
200 -- Test_Statement_Required --
201 -----------------------------
203 procedure Test_Statement_Required is
204 function All_Pragmas return Boolean;
205 -- Return True if statement list is all pragmas
211 function All_Pragmas return Boolean is
214 S := First (Statement_List);
215 while Present (S) loop
216 if Nkind (S) /= N_Pragma then
226 -- Start of processing for Test_Statement_Required
229 if Statement_Required then
231 -- Check no statement required after label in Ada 2012, and that
232 -- it is OK to have nothing but pragmas in a statement sequence.
234 if Ada_Version >= Ada_2012
235 and then not Is_Empty_List (Statement_List)
237 ((Nkind (Last (Statement_List)) = N_Label
238 and then Statement_Seen)
242 Null_Stm : constant Node_Id :=
243 Make_Null_Statement (Token_Ptr);
245 Set_Comes_From_Source (Null_Stm, False);
246 Append_To (Statement_List, Null_Stm);
249 -- If not Ada 2012, or not special case above, give error message
252 Error_Msg_BC -- CODEFIX
253 ("statement expected");
256 end Test_Statement_Required;
258 -- Start of processing for P_Sequence_Of_Statements
261 Statement_List := New_List;
262 Statement_Required := SS_Flags.Sreq;
263 Statement_Seen := False;
266 Ignore (Tok_Semicolon);
270 Style.Check_Indentation;
273 -- Deal with reserved identifier (in assignment or call)
275 if Is_Reserved_Identifier then
276 Save_Scan_State (Scan_State); -- at possible bad identifier
277 Scan; -- and scan past it
279 -- We have an reserved word which is spelled in identifier
280 -- style, so the question is whether it really is intended
281 -- to be an identifier.
284 -- If followed by a semicolon, then it is an identifier,
285 -- with the exception of the cases tested for below.
287 (Token = Tok_Semicolon
288 and then Prev_Token /= Tok_Return
289 and then Prev_Token /= Tok_Null
290 and then Prev_Token /= Tok_Raise
291 and then Prev_Token /= Tok_End
292 and then Prev_Token /= Tok_Exit)
294 -- If followed by colon, colon-equal, or dot, then we
295 -- definitely have an identifier (could not be reserved)
297 or else Token = Tok_Colon
298 or else Token = Tok_Colon_Equal
299 or else Token = Tok_Dot
301 -- Left paren means we have an identifier except for those
302 -- reserved words that can legitimately be followed by a
306 (Token = Tok_Left_Paren
307 and then Prev_Token /= Tok_Case
308 and then Prev_Token /= Tok_Delay
309 and then Prev_Token /= Tok_If
310 and then Prev_Token /= Tok_Elsif
311 and then Prev_Token /= Tok_Return
312 and then Prev_Token /= Tok_When
313 and then Prev_Token /= Tok_While
314 and then Prev_Token /= Tok_Separate)
316 -- Here we have an apparent reserved identifier and the
317 -- token past it is appropriate to this usage (and would
318 -- be a definite error if this is not an identifier). What
319 -- we do is to use P_Identifier to fix up the identifier,
320 -- and then fall into the normal processing.
322 Restore_Scan_State (Scan_State); -- back to the ID
323 Scan_Reserved_Identifier (Force_Msg => False);
325 -- Not a reserved identifier after all (or at least we can't
326 -- be sure that it is), so reset the scan and continue.
329 Restore_Scan_State (Scan_State); -- back to the reserved word
333 -- Now look to see what kind of statement we have
337 -- Case of end or EOF
339 when Tok_End | Tok_EOF =>
341 -- These tokens always terminate the statement sequence
343 Test_Statement_Required;
350 -- Terminate if Eftm set or if the ELSIF is to the left
351 -- of the expected column of the end for this sequence
354 or else Start_Column < Scope.Table (Scope.Last).Ecol
356 Test_Statement_Required;
359 -- Otherwise complain and skip past ELSIF Condition then
362 Error_Msg_SC ("ELSIF not allowed here");
364 Discard_Junk_Node (P_Expression_No_Right_Paren);
366 Statement_Required := False;
373 -- Terminate if Eltm set or if the else is to the left
374 -- of the expected column of the end for this sequence
377 or else Start_Column < Scope.Table (Scope.Last).Ecol
379 Test_Statement_Required;
382 -- Otherwise complain and skip past else
385 Error_Msg_SC ("ELSE not allowed here");
387 Statement_Required := False;
392 when Tok_Exception =>
393 Test_Statement_Required;
395 -- If Extm not set and the exception is not to the left of
396 -- the expected column of the end for this sequence, then we
397 -- assume it belongs to the current sequence, even though it
400 if not SS_Flags.Extm and then
401 Start_Column >= Scope.Table (Scope.Last).Ecol
404 Error_Msg_SC ("exception handler not permitted here");
405 Scan; -- past EXCEPTION
406 Discard_Junk_List (Parse_Exception_Handlers);
409 -- Always return, in the case where we scanned out handlers
410 -- that we did not expect, Parse_Exception_Handlers returned
411 -- with Token being either end or EOF, so we are OK.
419 -- Terminate if Ortm set or if the or is to the left of the
420 -- expected column of the end for this sequence.
423 or else Start_Column < Scope.Table (Scope.Last).Ecol
425 Test_Statement_Required;
428 -- Otherwise complain and skip past or
431 Error_Msg_SC ("OR not allowed here");
433 Statement_Required := False;
436 -- Case of THEN (deal also with THEN ABORT)
439 Save_Scan_State (Scan_State); -- at THEN
442 -- Terminate if THEN ABORT allowed (ATC case)
444 exit when SS_Flags.Tatm and then Token = Tok_Abort;
446 -- Otherwise we treat THEN as some kind of mess where we did
447 -- not see the associated IF, but we pick up assuming it had
450 Restore_Scan_State (Scan_State); -- to THEN
451 Append_To (Statement_List, P_If_Statement);
452 Statement_Required := False;
454 -- Case of WHEN (error because we are not in a case)
456 when Tok_When | Tok_Others =>
458 -- Terminate if Whtm set or if the WHEN is to the left of
459 -- the expected column of the end for this sequence.
462 or else Start_Column < Scope.Table (Scope.Last).Ecol
464 Test_Statement_Required;
467 -- Otherwise complain and skip when Choice {| Choice} =>
470 Error_Msg_SC ("WHEN not allowed here");
472 Discard_Junk_List (P_Discrete_Choice_List);
474 Statement_Required := False;
477 -- Cases of statements starting with an identifier
479 when Tok_Identifier =>
482 -- Save scan pointers and line number in case block label
484 Id_Node := Token_Node;
485 Block_Label := Token_Name;
486 Save_Scan_State (Scan_State_Label); -- at possible label
489 -- Check for common case of assignment, since it occurs
490 -- frequently, and we want to process it efficiently.
492 if Token = Tok_Colon_Equal then
493 Scan; -- past the colon-equal
494 Append_To (Statement_List,
495 P_Assignment_Statement (Id_Node));
496 Statement_Required := False;
498 -- Check common case of procedure call, another case that
499 -- we want to speed up as much as possible.
501 elsif Token = Tok_Semicolon then
502 Append_To (Statement_List,
503 P_Statement_Name (Id_Node));
504 Scan; -- past semicolon
505 Statement_Required := False;
507 -- Check for case of "go to" in place of "goto"
509 elsif Token = Tok_Identifier
510 and then Block_Label = Name_Go
511 and then Token_Name = Name_To
513 Error_Msg_SP -- CODEFIX
514 ("goto is one word");
515 Append_To (Statement_List, P_Goto_Statement);
516 Statement_Required := False;
518 -- Check common case of = used instead of :=, just so we
519 -- give a better error message for this special misuse.
521 elsif Token = Tok_Equal then
522 T_Colon_Equal; -- give := expected message
523 Append_To (Statement_List,
524 P_Assignment_Statement (Id_Node));
525 Statement_Required := False;
527 -- Check case of loop label or block label
529 elsif Token = Tok_Colon
530 or else (Token in Token_Class_Labeled_Stmt
531 and then not Token_Is_At_Start_Of_Line)
533 T_Colon; -- past colon (if there, or msg for missing one)
535 -- Test for more than one label
538 exit when Token /= Tok_Identifier;
539 Save_Scan_State (Scan_State); -- at second Id
542 if Token = Tok_Colon then
544 ("only one label allowed on block or loop");
545 Scan; -- past colon on extra label
547 -- Use the second label as the "real" label
549 Scan_State_Label := Scan_State;
551 -- We will set Error_name as the Block_Label since
552 -- we really don't know which of the labels might
553 -- be used at the end of the loop or block!
555 Block_Label := Error_Name;
557 -- If Id with no colon, then backup to point to the
558 -- Id and we will issue the message below when we try
559 -- to scan out the statement as some other form.
562 Restore_Scan_State (Scan_State); -- to second Id
567 -- Loop_Statement (labeled Loop_Statement)
569 if Token = Tok_Loop then
570 Append_To (Statement_List,
571 P_Loop_Statement (Id_Node));
573 -- While statement (labeled loop statement with WHILE)
575 elsif Token = Tok_While then
576 Append_To (Statement_List,
577 P_While_Statement (Id_Node));
579 -- Declare statement (labeled block statement with
582 elsif Token = Tok_Declare then
583 Append_To (Statement_List,
584 P_Declare_Statement (Id_Node));
586 -- Begin statement (labeled block statement with no
589 elsif Token = Tok_Begin then
590 Append_To (Statement_List,
591 P_Begin_Statement (Id_Node));
593 -- For statement (labeled loop statement with FOR)
595 elsif Token = Tok_For then
596 Append_To (Statement_List,
597 P_For_Statement (Id_Node));
599 -- Improper statement follows label. If we have an
600 -- expression token, then assume the colon was part
601 -- of a misplaced declaration.
603 elsif Token not in Token_Class_Eterm then
604 Restore_Scan_State (Scan_State_Label);
607 -- Otherwise complain we have inappropriate statement
611 ("loop or block statement must follow label");
614 Statement_Required := False;
616 -- Here we have an identifier followed by something
617 -- other than a colon, semicolon or assignment symbol.
618 -- The only valid possibility is a name extension symbol
620 elsif Token in Token_Class_Namext then
621 Restore_Scan_State (Scan_State_Label); -- to Id
624 -- Skip junk right parens in this context
626 Ignore (Tok_Right_Paren);
628 -- Check context following call
630 if Token = Tok_Colon_Equal then
631 Scan; -- past colon equal
632 Append_To (Statement_List,
633 P_Assignment_Statement (Name_Node));
634 Statement_Required := False;
636 -- Check common case of = used instead of :=
638 elsif Token = Tok_Equal then
639 T_Colon_Equal; -- give := expected message
640 Append_To (Statement_List,
641 P_Assignment_Statement (Name_Node));
642 Statement_Required := False;
644 -- Check apostrophe cases
646 elsif Token = Tok_Apostrophe then
647 Append_To (Statement_List,
648 P_Code_Statement (Name_Node));
649 Statement_Required := False;
651 -- The only other valid item after a name is ; which
652 -- means that the item we just scanned was a call.
654 elsif Token = Tok_Semicolon then
655 Append_To (Statement_List,
656 P_Statement_Name (Name_Node));
657 Scan; -- past semicolon
658 Statement_Required := False;
660 -- A slash following an identifier or a selected
661 -- component in this situation is most likely a period
662 -- (see location of keys on keyboard).
664 elsif Token = Tok_Slash
665 and then (Nkind (Name_Node) = N_Identifier
667 Nkind (Name_Node) = N_Selected_Component)
669 Error_Msg_SC -- CODEFIX
670 ("""/"" should be "".""");
671 Statement_Required := False;
674 -- Else we have a missing semicolon
678 Statement_Required := False;
681 -- If junk after identifier, check if identifier is an
682 -- instance of an incorrectly spelled keyword. If so, we
683 -- do nothing. The Bad_Spelling_Of will have reset Token
684 -- to the appropriate keyword, so the next time round the
685 -- loop we will process the modified token. Note that we
686 -- check for ELSIF before ELSE here. That's not accidental.
687 -- We don't want to identify a misspelling of ELSE as
688 -- ELSIF, and in particular we do not want to treat ELSEIF
692 Restore_Scan_State (Scan_State_Label); -- to identifier
694 if Bad_Spelling_Of (Tok_Abort)
695 or else Bad_Spelling_Of (Tok_Accept)
696 or else Bad_Spelling_Of (Tok_Case)
697 or else Bad_Spelling_Of (Tok_Declare)
698 or else Bad_Spelling_Of (Tok_Delay)
699 or else Bad_Spelling_Of (Tok_Elsif)
700 or else Bad_Spelling_Of (Tok_Else)
701 or else Bad_Spelling_Of (Tok_End)
702 or else Bad_Spelling_Of (Tok_Exception)
703 or else Bad_Spelling_Of (Tok_Exit)
704 or else Bad_Spelling_Of (Tok_For)
705 or else Bad_Spelling_Of (Tok_Goto)
706 or else Bad_Spelling_Of (Tok_If)
707 or else Bad_Spelling_Of (Tok_Loop)
708 or else Bad_Spelling_Of (Tok_Or)
709 or else Bad_Spelling_Of (Tok_Pragma)
710 or else Bad_Spelling_Of (Tok_Raise)
711 or else Bad_Spelling_Of (Tok_Requeue)
712 or else Bad_Spelling_Of (Tok_Return)
713 or else Bad_Spelling_Of (Tok_Select)
714 or else Bad_Spelling_Of (Tok_When)
715 or else Bad_Spelling_Of (Tok_While)
719 -- If not a bad spelling, then we really have junk
722 Scan; -- past identifier again
724 -- If next token is first token on line, then we
725 -- consider that we were missing a semicolon after
726 -- the identifier, and process it as a procedure
727 -- call with no parameters.
729 if Token_Is_At_Start_Of_Line then
730 Append_To (Statement_List,
731 P_Statement_Name (Id_Node));
732 T_Semicolon; -- to give error message
733 Statement_Required := False;
735 -- Otherwise we give a missing := message and
736 -- simply abandon the junk that is there now.
739 T_Colon_Equal; -- give := expected message
746 -- Statement starting with operator symbol. This could be
747 -- a call, a name starting an assignment, or a qualified
750 when Tok_Operator_Symbol =>
754 -- An attempt at a range attribute or a qualified expression
755 -- must be illegal here (a code statement cannot possibly
756 -- allow qualification by a function name).
758 if Token = Tok_Apostrophe then
759 Error_Msg_SC ("apostrophe illegal here");
763 -- Scan possible assignment if we have a name
765 if Expr_Form = EF_Name
766 and then Token = Tok_Colon_Equal
768 Scan; -- past colon equal
769 Append_To (Statement_List,
770 P_Assignment_Statement (Name_Node));
772 Append_To (Statement_List,
773 P_Statement_Name (Name_Node));
777 Statement_Required := False;
779 -- Label starting with << which must precede real statement
780 -- Note: in Ada 2012, the label may end the sequence.
782 when Tok_Less_Less =>
783 if Present (Last (Statement_List))
784 and then Nkind (Last (Statement_List)) /= N_Label
786 Statement_Seen := True;
789 Append_To (Statement_List, P_Label);
790 Statement_Required := True;
792 -- Pragma appearing as a statement in a statement sequence
796 Append_To (Statement_List, P_Pragma);
802 Append_To (Statement_List, P_Abort_Statement);
803 Statement_Required := False;
809 Append_To (Statement_List, P_Accept_Statement);
810 Statement_Required := False;
812 -- Begin_Statement (Block_Statement with no declare, no label)
816 Append_To (Statement_List, P_Begin_Statement);
817 Statement_Required := False;
823 Append_To (Statement_List, P_Case_Statement);
824 Statement_Required := False;
826 -- Block_Statement with DECLARE and no label
830 Append_To (Statement_List, P_Declare_Statement);
831 Statement_Required := False;
837 Append_To (Statement_List, P_Delay_Statement);
838 Statement_Required := False;
844 Append_To (Statement_List, P_Exit_Statement);
845 Statement_Required := False;
847 -- Loop_Statement with FOR and no label
851 Append_To (Statement_List, P_For_Statement);
852 Statement_Required := False;
858 Append_To (Statement_List, P_Goto_Statement);
859 Statement_Required := False;
865 Append_To (Statement_List, P_If_Statement);
866 Statement_Required := False;
872 Append_To (Statement_List, P_Loop_Statement);
873 Statement_Required := False;
879 Append_To (Statement_List, P_Null_Statement);
880 Statement_Required := False;
886 Append_To (Statement_List, P_Raise_Statement);
887 Statement_Required := False;
893 Append_To (Statement_List, P_Requeue_Statement);
894 Statement_Required := False;
900 Append_To (Statement_List, P_Return_Statement);
901 Statement_Required := False;
907 Append_To (Statement_List, P_Select_Statement);
908 Statement_Required := False;
910 -- While_Statement (Block_Statement with while and no loop)
914 Append_To (Statement_List, P_While_Statement);
915 Statement_Required := False;
917 -- Anything else is some kind of junk, signal an error message
918 -- and then raise Error_Resync, to merge with the normal
919 -- handling of a bad statement.
923 if Token in Token_Class_Declk then
927 Error_Msg_BC -- CODEFIX
928 ("statement expected");
933 -- On error resynchronization, skip past next semicolon, and, since
934 -- we are still in the statement loop, look for next statement. We
935 -- set Statement_Required False to avoid an unnecessary error message
936 -- complaining that no statement was found (i.e. we consider the
937 -- junk to satisfy the requirement for a statement being present).
941 Resync_Past_Semicolon_Or_To_Loop_Or_Then;
942 Statement_Required := False;
945 exit when SS_Flags.Unco;
949 return Statement_List;
951 end P_Sequence_Of_Statements;
957 -- Parsed by P_Sequence_Of_Statements (5.1), except for the case
958 -- of a statement of the form of a name, which is handled here. The
959 -- argument passed in is the tree for the name which has been scanned
960 -- The returned value is the corresponding statement form.
962 -- This routine is also used by Par.Prag for processing the procedure
963 -- call that appears as the second argument of a pragma Assert.
965 -- Error recovery: cannot raise Error_Resync
967 function P_Statement_Name (Name_Node : Node_Id) return Node_Id is
971 -- Case of Indexed component, which is a procedure call with arguments
973 if Nkind (Name_Node) = N_Indexed_Component then
975 Prefix_Node : constant Node_Id := Prefix (Name_Node);
976 Exprs_Node : constant List_Id := Expressions (Name_Node);
979 Change_Node (Name_Node, N_Procedure_Call_Statement);
980 Set_Name (Name_Node, Prefix_Node);
981 Set_Parameter_Associations (Name_Node, Exprs_Node);
985 -- Case of function call node, which is a really a procedure call
987 elsif Nkind (Name_Node) = N_Function_Call then
989 Fname_Node : constant Node_Id := Name (Name_Node);
990 Params_List : constant List_Id :=
991 Parameter_Associations (Name_Node);
994 Change_Node (Name_Node, N_Procedure_Call_Statement);
995 Set_Name (Name_Node, Fname_Node);
996 Set_Parameter_Associations (Name_Node, Params_List);
1000 -- Case of call to attribute that denotes a procedure. Here we
1001 -- just leave the attribute reference unchanged.
1003 elsif Nkind (Name_Node) = N_Attribute_Reference
1004 and then Is_Procedure_Attribute_Name (Attribute_Name (Name_Node))
1008 -- All other cases of names are parameterless procedure calls
1012 New_Node (N_Procedure_Call_Statement, Sloc (Name_Node));
1013 Set_Name (Stmt_Node, Name_Node);
1017 end P_Statement_Name;
1019 ---------------------------
1020 -- 5.1 Simple Statement --
1021 ---------------------------
1023 -- Parsed by P_Sequence_Of_Statements (5.1)
1025 -----------------------------
1026 -- 5.1 Compound Statement --
1027 -----------------------------
1029 -- Parsed by P_Sequence_Of_Statements (5.1)
1031 -------------------------
1032 -- 5.1 Null Statement --
1033 -------------------------
1035 -- NULL_STATEMENT ::= null;
1037 -- The caller has already checked that the current token is null
1039 -- Error recovery: cannot raise Error_Resync
1041 function P_Null_Statement return Node_Id is
1042 Null_Stmt_Node : Node_Id;
1045 Null_Stmt_Node := New_Node (N_Null_Statement, Token_Ptr);
1048 return Null_Stmt_Node;
1049 end P_Null_Statement;
1055 -- LABEL ::= <<label_STATEMENT_IDENTIFIER>>
1057 -- STATEMENT_IDENTIFIER ::= DIRECT_NAME
1059 -- The IDENTIFIER of a STATEMENT_IDENTIFIER shall be an identifier
1060 -- (not an OPERATOR_SYMBOL)
1062 -- The caller has already checked that the current token is <<
1064 -- Error recovery: can raise Error_Resync
1066 function P_Label return Node_Id is
1067 Label_Node : Node_Id;
1070 Label_Node := New_Node (N_Label, Token_Ptr);
1072 Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
1074 Append_Elmt (Label_Node, Label_List);
1078 -------------------------------
1079 -- 5.1 Statement Identifier --
1080 -------------------------------
1082 -- Statement label is parsed by P_Label (5.1)
1084 -- Loop label is parsed by P_Loop_Statement (5.5), P_For_Statement (5.5)
1085 -- or P_While_Statement (5.5)
1087 -- Block label is parsed by P_Begin_Statement (5.6) or
1088 -- P_Declare_Statement (5.6)
1090 -------------------------------
1091 -- 5.2 Assignment Statement --
1092 -------------------------------
1094 -- ASSIGNMENT_STATEMENT ::=
1095 -- variable_NAME := EXPRESSION;
1097 -- Error recovery: can raise Error_Resync
1099 function P_Assignment_Statement (LHS : Node_Id) return Node_Id is
1100 Assign_Node : Node_Id;
1103 Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr);
1104 Set_Name (Assign_Node, LHS);
1105 Set_Expression (Assign_Node, P_Expression_No_Right_Paren);
1108 end P_Assignment_Statement;
1110 -----------------------
1111 -- 5.3 If Statement --
1112 -----------------------
1115 -- if CONDITION then
1116 -- SEQUENCE_OF_STATEMENTS
1117 -- {elsif CONDITION then
1118 -- SEQUENCE_OF_STATEMENTS}
1120 -- SEQUENCE_OF_STATEMENTS]
1123 -- The caller has checked that the initial token is IF (or in the error
1124 -- case of a mysterious THEN, the initial token may simply be THEN, in
1125 -- which case, no condition (or IF) was scanned).
1127 -- Error recovery: can raise Error_Resync
1129 function P_If_Statement return Node_Id is
1131 Elsif_Node : Node_Id;
1134 procedure Add_Elsif_Part;
1135 -- An internal procedure used to scan out a single ELSIF part. On entry
1136 -- the ELSIF (or an ELSE which has been determined should be ELSIF) is
1137 -- scanned out and is in Prev_Token.
1139 procedure Check_If_Column;
1140 -- An internal procedure used to check that THEN, ELSE, or ELSIF
1141 -- appear in the right place if column checking is enabled (i.e. if
1142 -- they are the first token on the line, then they must appear in
1143 -- the same column as the opening IF).
1145 procedure Check_Then_Column;
1146 -- This procedure carries out the style checks for a THEN token
1147 -- Note that the caller has set Loc to the Source_Ptr value for
1148 -- the previous IF or ELSIF token. These checks apply only to a
1149 -- THEN at the start of a line.
1151 function Else_Should_Be_Elsif return Boolean;
1152 -- An internal routine used to do a special error recovery check when
1153 -- an ELSE is encountered. It determines if the ELSE should be treated
1154 -- as an ELSIF. A positive decision (TRUE returned, is made if the ELSE
1155 -- is followed by a sequence of tokens, starting on the same line as
1156 -- the ELSE, which are not expression terminators, followed by a THEN.
1157 -- On entry, the ELSE has been scanned out.
1159 procedure Add_Elsif_Part is
1161 if No (Elsif_Parts (If_Node)) then
1162 Set_Elsif_Parts (If_Node, New_List);
1165 Elsif_Node := New_Node (N_Elsif_Part, Prev_Token_Ptr);
1166 Loc := Prev_Token_Ptr;
1167 Set_Condition (Elsif_Node, P_Condition);
1171 (Elsif_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1172 Append (Elsif_Node, Elsif_Parts (If_Node));
1175 procedure Check_If_Column is
1177 if RM_Column_Check and then Token_Is_At_Start_Of_Line
1178 and then Start_Column /= Scope.Table (Scope.Last).Ecol
1180 Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
1181 Error_Msg_SC ("(style) this token should be@");
1183 end Check_If_Column;
1185 procedure Check_Then_Column is
1187 if Token_Is_At_Start_Of_Line and then Token = Tok_Then then
1191 Style.Check_Then (Loc);
1194 end Check_Then_Column;
1196 function Else_Should_Be_Elsif return Boolean is
1197 Scan_State : Saved_Scan_State;
1200 if Token_Is_At_Start_Of_Line then
1204 Save_Scan_State (Scan_State);
1207 if Token in Token_Class_Eterm then
1208 Restore_Scan_State (Scan_State);
1211 Scan; -- past non-expression terminating token
1213 if Token = Tok_Then then
1214 Restore_Scan_State (Scan_State);
1220 end Else_Should_Be_Elsif;
1222 -- Start of processing for P_If_Statement
1225 If_Node := New_Node (N_If_Statement, Token_Ptr);
1228 Scope.Table (Scope.Last).Etyp := E_If;
1229 Scope.Table (Scope.Last).Ecol := Start_Column;
1230 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1231 Scope.Table (Scope.Last).Labl := Error;
1232 Scope.Table (Scope.Last).Node := If_Node;
1234 if Token = Tok_If then
1237 Set_Condition (If_Node, P_Condition);
1239 -- Deal with misuse of IF expression => used instead
1240 -- of WHEN expression =>
1242 if Token = Tok_Arrow then
1243 Error_Msg_SC -- CODEFIX
1245 Scan; -- past the arrow
1246 Pop_Scope_Stack; -- remove unneeded entry
1253 Error_Msg_SC ("no IF for this THEN");
1254 Set_Condition (If_Node, Error);
1260 (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1262 -- This loop scans out else and elsif parts
1265 if Token = Tok_Elsif then
1268 if Present (Else_Statements (If_Node)) then
1269 Error_Msg_SP ("ELSIF cannot appear after ELSE");
1275 elsif Token = Tok_Else then
1279 if Else_Should_Be_Elsif then
1280 Error_Msg_SP -- CODEFIX
1281 ("ELSE should be ELSIF");
1285 -- Here we have an else that really is an else
1287 if Present (Else_Statements (If_Node)) then
1288 Error_Msg_SP ("only one ELSE part allowed");
1290 (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq),
1291 Else_Statements (If_Node));
1294 (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
1298 -- If anything other than ELSE or ELSIF, exit the loop. The token
1299 -- had better be END (and in fact it had better be END IF), but
1300 -- we will let End_Statements take care of checking that.
1312 --------------------
1314 --------------------
1316 -- CONDITION ::= boolean_EXPRESSION
1318 function P_Condition return Node_Id is
1322 Cond := P_Expression_No_Right_Paren;
1324 -- It is never possible for := to follow a condition, so if we get
1325 -- a := we assume it is a mistyped equality. Note that we do not try
1326 -- to reconstruct the tree correctly in this case, but we do at least
1327 -- give an accurate error message.
1329 if Token = Tok_Colon_Equal then
1330 while Token = Tok_Colon_Equal loop
1331 Error_Msg_SC -- CODEFIX
1332 (""":="" should be ""=""");
1333 Scan; -- past junk :=
1334 Discard_Junk_Node (P_Expression_No_Right_Paren);
1339 -- Otherwise check for redundant parens
1343 and then Paren_Count (Cond) > 0
1345 Style.Check_Xtra_Parens (First_Sloc (Cond));
1348 -- And return the result
1354 -------------------------
1355 -- 5.4 Case Statement --
1356 -------------------------
1358 -- CASE_STATEMENT ::=
1359 -- case EXPRESSION is
1360 -- CASE_STATEMENT_ALTERNATIVE
1361 -- {CASE_STATEMENT_ALTERNATIVE}
1364 -- The caller has checked that the first token is CASE
1366 -- Can raise Error_Resync
1368 function P_Case_Statement return Node_Id is
1369 Case_Node : Node_Id;
1370 Alternatives_List : List_Id;
1371 First_When_Loc : Source_Ptr;
1374 Case_Node := New_Node (N_Case_Statement, Token_Ptr);
1377 Scope.Table (Scope.Last).Etyp := E_Case;
1378 Scope.Table (Scope.Last).Ecol := Start_Column;
1379 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1380 Scope.Table (Scope.Last).Labl := Error;
1381 Scope.Table (Scope.Last).Node := Case_Node;
1384 Set_Expression (Case_Node, P_Expression_No_Right_Paren);
1387 -- Prepare to parse case statement alternatives
1389 Alternatives_List := New_List;
1390 P_Pragmas_Opt (Alternatives_List);
1391 First_When_Loc := Token_Ptr;
1393 -- Loop through case statement alternatives
1396 -- If we have a WHEN or OTHERS, then that's fine keep going. Note
1397 -- that it is a semantic check to ensure the proper use of OTHERS
1399 if Token = Tok_When or else Token = Tok_Others then
1400 Append (P_Case_Statement_Alternative, Alternatives_List);
1402 -- If we have an END, then probably we are at the end of the case
1403 -- but we only exit if Check_End thinks the END was reasonable.
1405 elsif Token = Tok_End then
1406 exit when Check_End;
1408 -- Here if token is other than WHEN, OTHERS or END. We definitely
1409 -- have an error, but the question is whether or not to get out of
1410 -- the case statement. We don't want to get out early, or we will
1411 -- get a slew of junk error messages for subsequent when tokens.
1413 -- If the token is not at the start of the line, or if it is indented
1414 -- with respect to the current case statement, then the best guess is
1415 -- that we are still supposed to be inside the case statement. We
1416 -- complain about the missing WHEN, and discard the junk statements.
1418 elsif not Token_Is_At_Start_Of_Line
1419 or else Start_Column > Scope.Table (Scope.Last).Ecol
1421 Error_Msg_BC ("WHEN (case statement alternative) expected");
1423 -- Here is a possibility for infinite looping if we don't make
1424 -- progress. So try to process statements, otherwise exit
1427 Error_Ptr : constant Source_Ptr := Scan_Ptr;
1429 Discard_Junk_List (P_Sequence_Of_Statements (SS_Whtm));
1430 exit when Scan_Ptr = Error_Ptr and then Check_End;
1433 -- Here we have a junk token at the start of the line and it is
1434 -- not indented. If Check_End thinks there is a missing END, then
1435 -- we will get out of the case, otherwise we keep going.
1438 exit when Check_End;
1442 -- Make sure we have at least one alternative
1444 if No (First_Non_Pragma (Alternatives_List)) then
1446 ("WHEN expected, must have at least one alternative in case",
1451 Set_Alternatives (Case_Node, Alternatives_List);
1454 end P_Case_Statement;
1456 -------------------------------------
1457 -- 5.4 Case Statement Alternative --
1458 -------------------------------------
1460 -- CASE_STATEMENT_ALTERNATIVE ::=
1461 -- when DISCRETE_CHOICE_LIST =>
1462 -- SEQUENCE_OF_STATEMENTS
1464 -- The caller has checked that the initial token is WHEN or OTHERS
1465 -- Error recovery: can raise Error_Resync
1467 function P_Case_Statement_Alternative return Node_Id is
1468 Case_Alt_Node : Node_Id;
1472 Style.Check_Indentation;
1475 Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr);
1476 T_When; -- past WHEN (or give error in OTHERS case)
1477 Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
1479 Set_Statements (Case_Alt_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
1480 return Case_Alt_Node;
1481 end P_Case_Statement_Alternative;
1483 -------------------------
1484 -- 5.5 Loop Statement --
1485 -------------------------
1487 -- LOOP_STATEMENT ::=
1488 -- [LOOP_STATEMENT_IDENTIFIER:]
1489 -- [ITERATION_SCHEME] loop
1490 -- SEQUENCE_OF_STATEMENTS
1491 -- end loop [loop_IDENTIFIER];
1493 -- ITERATION_SCHEME ::=
1495 -- | for LOOP_PARAMETER_SPECIFICATION
1497 -- The parsing of loop statements is handled by one of three functions
1498 -- P_Loop_Statement, P_For_Statement or P_While_Statement depending
1499 -- on the initial keyword in the construct (excluding the identifier)
1503 -- This function parses the case where no iteration scheme is present
1505 -- The caller has checked that the initial token is LOOP. The parameter
1506 -- is the node identifiers for the loop label if any (or is set to Empty
1507 -- if there is no loop label).
1509 -- Error recovery : cannot raise Error_Resync
1511 function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1512 Loop_Node : Node_Id;
1513 Created_Name : Node_Id;
1517 Scope.Table (Scope.Last).Labl := Loop_Name;
1518 Scope.Table (Scope.Last).Ecol := Start_Column;
1519 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1520 Scope.Table (Scope.Last).Etyp := E_Loop;
1522 Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1525 if No (Loop_Name) then
1527 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1528 Set_Comes_From_Source (Created_Name, False);
1529 Set_Has_Created_Identifier (Loop_Node, True);
1530 Set_Identifier (Loop_Node, Created_Name);
1531 Scope.Table (Scope.Last).Labl := Created_Name;
1533 Set_Identifier (Loop_Node, Loop_Name);
1536 Append_Elmt (Loop_Node, Label_List);
1537 Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1538 End_Statements (Loop_Node);
1540 end P_Loop_Statement;
1544 -- This function parses a loop statement with a FOR iteration scheme
1546 -- The caller has checked that the initial token is FOR. The parameter
1547 -- is the node identifier for the block label if any (or is set to Empty
1548 -- if there is no block label).
1550 -- Note: the caller fills in the Identifier field if a label was present
1552 -- Error recovery: can raise Error_Resync
1554 function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1555 Loop_Node : Node_Id;
1556 Iter_Scheme_Node : Node_Id;
1557 Loop_For_Flag : Boolean;
1558 Created_Name : Node_Id;
1563 Scope.Table (Scope.Last).Labl := Loop_Name;
1564 Scope.Table (Scope.Last).Ecol := Start_Column;
1565 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1566 Scope.Table (Scope.Last).Etyp := E_Loop;
1568 Loop_For_Flag := (Prev_Token = Tok_Loop);
1570 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1571 Spec := P_Loop_Parameter_Specification;
1573 if Nkind (Spec) = N_Loop_Parameter_Specification then
1574 Set_Loop_Parameter_Specification (Iter_Scheme_Node, Spec);
1576 Set_Iterator_Specification (Iter_Scheme_Node, Spec);
1579 -- The following is a special test so that a miswritten for loop such
1580 -- as "loop for I in 1..10;" is handled nicely, without making an extra
1581 -- entry in the scope stack. We don't bother to actually fix up the
1582 -- tree in this case since it's not worth the effort. Instead we just
1583 -- eat up the loop junk, leaving the entry for what now looks like an
1584 -- unmodified loop intact.
1586 if Loop_For_Flag and then Token = Tok_Semicolon then
1587 Error_Msg_SC ("LOOP belongs here, not before FOR");
1594 Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1596 if No (Loop_Name) then
1598 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1599 Set_Comes_From_Source (Created_Name, False);
1600 Set_Has_Created_Identifier (Loop_Node, True);
1601 Set_Identifier (Loop_Node, Created_Name);
1602 Scope.Table (Scope.Last).Labl := Created_Name;
1604 Set_Identifier (Loop_Node, Loop_Name);
1608 Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1609 End_Statements (Loop_Node);
1610 Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
1611 Append_Elmt (Loop_Node, Label_List);
1614 end P_For_Statement;
1616 -- P_While_Statement
1618 -- This procedure scans a loop statement with a WHILE iteration scheme
1620 -- The caller has checked that the initial token is WHILE. The parameter
1621 -- is the node identifier for the block label if any (or is set to Empty
1622 -- if there is no block label).
1624 -- Error recovery: cannot raise Error_Resync
1626 function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
1627 Loop_Node : Node_Id;
1628 Iter_Scheme_Node : Node_Id;
1629 Loop_While_Flag : Boolean;
1630 Created_Name : Node_Id;
1634 Scope.Table (Scope.Last).Labl := Loop_Name;
1635 Scope.Table (Scope.Last).Ecol := Start_Column;
1636 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1637 Scope.Table (Scope.Last).Etyp := E_Loop;
1639 Loop_While_Flag := (Prev_Token = Tok_Loop);
1640 Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
1642 Set_Condition (Iter_Scheme_Node, P_Condition);
1644 -- The following is a special test so that a miswritten for loop such
1645 -- as "loop while I > 10;" is handled nicely, without making an extra
1646 -- entry in the scope stack. We don't bother to actually fix up the
1647 -- tree in this case since it's not worth the effort. Instead we just
1648 -- eat up the loop junk, leaving the entry for what now looks like an
1649 -- unmodified loop intact.
1651 if Loop_While_Flag and then Token = Tok_Semicolon then
1652 Error_Msg_SC ("LOOP belongs here, not before WHILE");
1659 Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
1662 if No (Loop_Name) then
1664 Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
1665 Set_Comes_From_Source (Created_Name, False);
1666 Set_Has_Created_Identifier (Loop_Node, True);
1667 Set_Identifier (Loop_Node, Created_Name);
1668 Scope.Table (Scope.Last).Labl := Created_Name;
1670 Set_Identifier (Loop_Node, Loop_Name);
1673 Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
1674 End_Statements (Loop_Node);
1675 Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
1676 Append_Elmt (Loop_Node, Label_List);
1679 end P_While_Statement;
1681 ---------------------------------------
1682 -- 5.5 Loop Parameter Specification --
1683 ---------------------------------------
1685 -- LOOP_PARAMETER_SPECIFICATION ::=
1686 -- DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
1688 -- Error recovery: cannot raise Error_Resync
1690 function P_Loop_Parameter_Specification return Node_Id is
1691 Loop_Param_Specification_Node : Node_Id;
1694 Scan_State : Saved_Scan_State;
1698 Save_Scan_State (Scan_State);
1699 ID_Node := P_Defining_Identifier (C_In);
1701 -- If the next token is OF, it indicates an Ada 2012 iterator. If the
1702 -- next token is a colon, this is also an Ada 2012 iterator, including
1703 -- a subtype indication for the loop parameter. Otherwise we parse the
1704 -- construct as a loop parameter specification. Note that the form
1705 -- "for A in B" is ambiguous, and must be resolved semantically: if B
1706 -- is a discrete subtype this is a loop specification, but if it is an
1707 -- expression it is an iterator specification. Ambiguity is resolved
1708 -- during analysis of the loop parameter specification.
1710 if Token = Tok_Of or else Token = Tok_Colon then
1711 if Ada_Version < Ada_2012 then
1712 Error_Msg_SC ("iterator is an Ada2012 feature");
1715 return P_Iterator_Specification (ID_Node);
1718 -- The span of the Loop_Parameter_Specification starts at the
1719 -- defining identifier.
1721 Loop_Param_Specification_Node :=
1722 New_Node (N_Loop_Parameter_Specification, Sloc (ID_Node));
1723 Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
1725 if Token = Tok_Left_Paren then
1726 Error_Msg_SC ("subscripted loop parameter not allowed");
1727 Restore_Scan_State (Scan_State);
1728 Discard_Junk_Node (P_Name);
1730 elsif Token = Tok_Dot then
1731 Error_Msg_SC ("selected loop parameter not allowed");
1732 Restore_Scan_State (Scan_State);
1733 Discard_Junk_Node (P_Name);
1738 if Token = Tok_Reverse then
1739 Scan; -- past REVERSE
1740 Set_Reverse_Present (Loop_Param_Specification_Node, True);
1743 Set_Discrete_Subtype_Definition
1744 (Loop_Param_Specification_Node, P_Discrete_Subtype_Definition);
1745 return Loop_Param_Specification_Node;
1748 when Error_Resync =>
1750 end P_Loop_Parameter_Specification;
1752 ----------------------------------
1753 -- 5.5.1 Iterator_Specification --
1754 ----------------------------------
1756 function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id is
1760 Node1 := New_Node (N_Iterator_Specification, Sloc (Def_Id));
1761 Set_Defining_Identifier (Node1, Def_Id);
1763 if Token = Tok_Colon then
1765 Set_Subtype_Indication (Node1, P_Subtype_Indication);
1768 if Token = Tok_Of then
1769 Set_Of_Present (Node1);
1772 elsif Token = Tok_In then
1779 if Token = Tok_Reverse then
1780 Scan; -- past REVERSE
1781 Set_Reverse_Present (Node1, True);
1784 Set_Name (Node1, P_Name);
1786 end P_Iterator_Specification;
1788 --------------------------
1789 -- 5.6 Block Statement --
1790 --------------------------
1792 -- BLOCK_STATEMENT ::=
1793 -- [block_STATEMENT_IDENTIFIER:]
1795 -- DECLARATIVE_PART]
1797 -- HANDLED_SEQUENCE_OF_STATEMENTS
1798 -- end [block_IDENTIFIER];
1800 -- The parsing of block statements is handled by one of the two functions
1801 -- P_Declare_Statement or P_Begin_Statement depending on whether or not
1802 -- a declare section is present
1804 -- P_Declare_Statement
1806 -- This function parses a block statement with DECLARE present
1808 -- The caller has checked that the initial token is DECLARE
1810 -- Error recovery: cannot raise Error_Resync
1812 function P_Declare_Statement
1813 (Block_Name : Node_Id := Empty)
1816 Block_Node : Node_Id;
1817 Created_Name : Node_Id;
1820 Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1823 Scope.Table (Scope.Last).Etyp := E_Name;
1824 Scope.Table (Scope.Last).Lreq := Present (Block_Name);
1825 Scope.Table (Scope.Last).Ecol := Start_Column;
1826 Scope.Table (Scope.Last).Labl := Block_Name;
1827 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1829 Scan; -- past DECLARE
1831 if No (Block_Name) then
1833 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1834 Set_Comes_From_Source (Created_Name, False);
1835 Set_Has_Created_Identifier (Block_Node, True);
1836 Set_Identifier (Block_Node, Created_Name);
1837 Scope.Table (Scope.Last).Labl := Created_Name;
1839 Set_Identifier (Block_Node, Block_Name);
1842 Append_Elmt (Block_Node, Label_List);
1843 Parse_Decls_Begin_End (Block_Node);
1845 end P_Declare_Statement;
1847 -- P_Begin_Statement
1849 -- This function parses a block statement with no DECLARE present
1851 -- The caller has checked that the initial token is BEGIN
1853 -- Error recovery: cannot raise Error_Resync
1855 function P_Begin_Statement
1856 (Block_Name : Node_Id := Empty)
1859 Block_Node : Node_Id;
1860 Created_Name : Node_Id;
1863 Block_Node := New_Node (N_Block_Statement, Token_Ptr);
1866 Scope.Table (Scope.Last).Etyp := E_Name;
1867 Scope.Table (Scope.Last).Lreq := Present (Block_Name);
1868 Scope.Table (Scope.Last).Ecol := Start_Column;
1869 Scope.Table (Scope.Last).Labl := Block_Name;
1870 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1872 if No (Block_Name) then
1874 Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
1875 Set_Comes_From_Source (Created_Name, False);
1876 Set_Has_Created_Identifier (Block_Node, True);
1877 Set_Identifier (Block_Node, Created_Name);
1878 Scope.Table (Scope.Last).Labl := Created_Name;
1880 Set_Identifier (Block_Node, Block_Name);
1883 Append_Elmt (Block_Node, Label_List);
1885 Scope.Table (Scope.Last).Ecol := Start_Column;
1886 Scope.Table (Scope.Last).Sloc := Token_Ptr;
1888 Set_Handled_Statement_Sequence
1889 (Block_Node, P_Handled_Sequence_Of_Statements);
1890 End_Statements (Handled_Statement_Sequence (Block_Node));
1892 end P_Begin_Statement;
1894 -------------------------
1895 -- 5.7 Exit Statement --
1896 -------------------------
1898 -- EXIT_STATEMENT ::=
1899 -- exit [loop_NAME] [when CONDITION];
1901 -- The caller has checked that the initial token is EXIT
1903 -- Error recovery: can raise Error_Resync
1905 function P_Exit_Statement return Node_Id is
1906 Exit_Node : Node_Id;
1908 function Missing_Semicolon_On_Exit return Boolean;
1909 -- This function deals with the following specialized situation
1912 -- exit [identifier]
1915 -- This looks like a messed up EXIT WHEN, when in fact the problem
1916 -- is a missing semicolon. It is called with Token pointing to the
1917 -- WHEN token, and returns True if a semicolon is missing before
1918 -- the WHEN as in the above example.
1920 -------------------------------
1921 -- Missing_Semicolon_On_Exit --
1922 -------------------------------
1924 function Missing_Semicolon_On_Exit return Boolean is
1925 State : Saved_Scan_State;
1928 if not Token_Is_At_Start_Of_Line then
1931 elsif Scope.Table (Scope.Last).Etyp /= E_Case then
1935 Save_Scan_State (State);
1937 Scan; -- past token after WHEN
1939 if Token = Tok_Arrow then
1940 Restore_Scan_State (State);
1943 Restore_Scan_State (State);
1947 end Missing_Semicolon_On_Exit;
1949 -- Start of processing for P_Exit_Statement
1952 Exit_Node := New_Node (N_Exit_Statement, Token_Ptr);
1955 if Token = Tok_Identifier then
1956 Set_Name (Exit_Node, P_Qualified_Simple_Name);
1958 elsif Style_Check then
1959 -- This EXIT has no name, so check that
1960 -- the innermost loop is unnamed too.
1962 Check_No_Exit_Name :
1963 for J in reverse 1 .. Scope.Last loop
1964 if Scope.Table (J).Etyp = E_Loop then
1965 if Present (Scope.Table (J).Labl)
1966 and then Comes_From_Source (Scope.Table (J).Labl)
1968 -- Innermost loop in fact had a name, style check fails
1970 Style.No_Exit_Name (Scope.Table (J).Labl);
1973 exit Check_No_Exit_Name;
1975 end loop Check_No_Exit_Name;
1978 if Token = Tok_When and then not Missing_Semicolon_On_Exit then
1980 Set_Condition (Exit_Node, P_Condition);
1982 -- Allow IF instead of WHEN, giving error message
1984 elsif Token = Tok_If then
1986 Scan; -- past IF used in place of WHEN
1987 Set_Condition (Exit_Node, P_Expression_No_Right_Paren);
1992 end P_Exit_Statement;
1994 -------------------------
1995 -- 5.8 Goto Statement --
1996 -------------------------
1998 -- GOTO_STATEMENT ::= goto label_NAME;
2000 -- The caller has checked that the initial token is GOTO (or TO in the
2001 -- error case where GO and TO were incorrectly separated).
2003 -- Error recovery: can raise Error_Resync
2005 function P_Goto_Statement return Node_Id is
2006 Goto_Node : Node_Id;
2009 Goto_Node := New_Node (N_Goto_Statement, Token_Ptr);
2010 Scan; -- past GOTO (or TO)
2011 Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync);
2012 Append_Elmt (Goto_Node, Goto_List);
2016 end P_Goto_Statement;
2018 ---------------------------
2019 -- Parse_Decls_Begin_End --
2020 ---------------------------
2022 -- This function parses the construct:
2026 -- HANDLED_SEQUENCE_OF_STATEMENTS
2029 -- The caller has built the scope stack entry, and created the node to
2030 -- whose Declarations and Handled_Statement_Sequence fields are to be
2031 -- set. On return these fields are filled in (except in the case of a
2032 -- task body, where the handled statement sequence is optional, and may
2033 -- thus be Empty), and the scan is positioned past the End sequence.
2035 -- If the BEGIN is missing, then the parent node is used to help construct
2036 -- an appropriate missing BEGIN message. Possibilities for the parent are:
2038 -- N_Block_Statement declare block
2039 -- N_Entry_Body entry body
2040 -- N_Package_Body package body (begin part optional)
2041 -- N_Subprogram_Body procedure or function body
2042 -- N_Task_Body task body
2044 -- Note: in the case of a block statement, there is definitely a DECLARE
2045 -- present (because a Begin statement without a DECLARE is handled by the
2046 -- P_Begin_Statement procedure, which does not call Parse_Decls_Begin_End.
2048 -- Error recovery: cannot raise Error_Resync
2050 procedure Parse_Decls_Begin_End (Parent : Node_Id) is
2051 Body_Decl : Node_Id;
2052 Body_Sloc : Source_Ptr;
2055 Parent_Nkind : Node_Kind;
2056 Spec_Node : Node_Id;
2059 procedure Missing_Begin (Msg : String);
2060 -- Called to post a missing begin message. In the normal case this is
2061 -- posted at the start of the current token. A special case arises when
2062 -- P_Declarative_Items has previously found a missing begin, in which
2063 -- case we replace the original error message.
2065 procedure Set_Null_HSS (Parent : Node_Id);
2066 -- Construct an empty handled statement sequence and install in Parent
2067 -- Leaves HSS set to reference the newly constructed statement sequence.
2073 procedure Missing_Begin (Msg : String) is
2075 if Missing_Begin_Msg = No_Error_Msg then
2078 Change_Error_Text (Missing_Begin_Msg, Msg);
2080 -- Purge any messages issued after than, since a missing begin
2081 -- can cause a lot of havoc, and it is better not to dump these
2082 -- cascaded messages on the user.
2084 Purge_Messages (Get_Location (Missing_Begin_Msg), Prev_Token_Ptr);
2092 procedure Set_Null_HSS (Parent : Node_Id) is
2097 Make_Null_Statement (Token_Ptr);
2098 Set_Comes_From_Source (Null_Stm, False);
2101 Make_Handled_Sequence_Of_Statements (Token_Ptr,
2102 Statements => New_List (Null_Stm));
2103 Set_Comes_From_Source (HSS, False);
2105 Set_Handled_Statement_Sequence (Parent, HSS);
2108 -- Start of processing for Parse_Decls_Begin_End
2111 Decls := P_Declarative_Part;
2113 -- Check for misplacement of later vs basic declarations in Ada 83
2115 if Ada_Version = Ada_83 then
2116 Decl := First (Decls);
2118 -- Loop through sequence of basic declarative items
2120 Outer : while Present (Decl) loop
2121 if Nkind (Decl) /= N_Subprogram_Body
2122 and then Nkind (Decl) /= N_Package_Body
2123 and then Nkind (Decl) /= N_Task_Body
2124 and then Nkind (Decl) not in N_Body_Stub
2128 -- Once a body is encountered, we only allow later declarative
2129 -- items. The inner loop checks the rest of the list.
2132 Body_Sloc := Sloc (Decl);
2134 Inner : while Present (Decl) loop
2135 if Nkind (Decl) not in N_Later_Decl_Item
2136 and then Nkind (Decl) /= N_Pragma
2138 if Ada_Version = Ada_83 then
2139 Error_Msg_Sloc := Body_Sloc;
2141 ("(Ada 83) decl cannot appear after body#", Decl);
2151 -- Here is where we deal with the case of IS used instead of semicolon.
2152 -- Specifically, if the last declaration in the declarative part is a
2153 -- subprogram body still marked as having a bad IS, then this is where
2154 -- we decide that the IS should really have been a semicolon and that
2155 -- the body should have been a declaration. Note that if the bad IS
2156 -- had turned out to be OK (i.e. a decent begin/end was found for it),
2157 -- then the Bad_Is_Detected flag would have been reset by now.
2159 Body_Decl := Last (Decls);
2161 if Present (Body_Decl)
2162 and then Nkind (Body_Decl) = N_Subprogram_Body
2163 and then Bad_Is_Detected (Body_Decl)
2165 -- OK, we have the case of a bad IS, so we need to fix up the tree.
2166 -- What we have now is a subprogram body with attached declarations
2167 -- and a possible statement sequence.
2169 -- First step is to take the declarations that were part of the bogus
2170 -- subprogram body and append them to the outer declaration chain.
2171 -- In other words we append them past the body (which we will later
2172 -- convert into a declaration).
2174 Append_List (Declarations (Body_Decl), Decls);
2176 -- Now take the handled statement sequence of the bogus body and
2177 -- set it as the statement sequence for the outer construct. Note
2178 -- that it may be empty (we specially allowed a missing BEGIN for
2179 -- a subprogram body marked as having a bad IS -- see below).
2181 Set_Handled_Statement_Sequence (Parent,
2182 Handled_Statement_Sequence (Body_Decl));
2184 -- Next step is to convert the old body node to a declaration node
2186 Spec_Node := Specification (Body_Decl);
2187 Change_Node (Body_Decl, N_Subprogram_Declaration);
2188 Set_Specification (Body_Decl, Spec_Node);
2190 -- Final step is to put the declarations for the parent where
2191 -- they belong, and then fall through the IF to scan out the
2194 Set_Declarations (Parent, Decls);
2196 -- This is the normal case (i.e. any case except the bad IS case)
2197 -- If we have a BEGIN, then scan out the sequence of statements, and
2198 -- also reset the expected column for the END to match the BEGIN.
2201 Set_Declarations (Parent, Decls);
2203 if Token = Tok_Begin then
2205 Style.Check_Indentation;
2208 Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
2211 and then Token_Is_At_Start_Of_Line
2212 and then Start_Column /= Error_Msg_Col
2214 Error_Msg_SC ("(style) BEGIN in wrong column, should be@");
2217 Scope.Table (Scope.Last).Ecol := Start_Column;
2220 Scope.Table (Scope.Last).Sloc := Token_Ptr;
2222 Set_Handled_Statement_Sequence (Parent,
2223 P_Handled_Sequence_Of_Statements);
2228 Parent_Nkind := Nkind (Parent);
2230 -- A special check for the missing IS case. If we have a
2231 -- subprogram body that was marked as having a suspicious
2232 -- IS, and the current token is END, then we simply confirm
2233 -- the suspicion, and do not require a BEGIN to be present
2235 if Parent_Nkind = N_Subprogram_Body
2236 and then Token = Tok_End
2237 and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is
2239 Scope.Table (Scope.Last).Etyp := E_Bad_Is;
2241 -- Otherwise BEGIN is not required for a package body, so we
2242 -- don't mind if it is missing, but we do construct a dummy
2243 -- one (so that we have somewhere to set End_Label).
2245 -- However if we have something other than a BEGIN which
2246 -- looks like it might be statements, then we signal a missing
2247 -- BEGIN for these cases as well. We define "something which
2248 -- looks like it might be statements" as a token other than
2249 -- END, EOF, or a token which starts declarations.
2251 elsif Parent_Nkind = N_Package_Body
2252 and then (Token = Tok_End
2253 or else Token = Tok_EOF
2254 or else Token in Token_Class_Declk)
2256 Set_Null_HSS (Parent);
2258 -- These are cases in which a BEGIN is required and not present
2261 Set_Null_HSS (Parent);
2263 -- Prepare to issue error message
2265 Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
2266 Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
2268 -- Now issue appropriate message
2270 if Parent_Nkind = N_Block_Statement then
2271 Missing_Begin ("missing BEGIN for DECLARE#!");
2273 elsif Parent_Nkind = N_Entry_Body then
2274 Missing_Begin ("missing BEGIN for ENTRY#!");
2276 elsif Parent_Nkind = N_Subprogram_Body then
2277 if Nkind (Specification (Parent))
2278 = N_Function_Specification
2280 Missing_Begin ("missing BEGIN for function&#!");
2282 Missing_Begin ("missing BEGIN for procedure&#!");
2285 -- The case for package body arises only when
2286 -- we have possible statement junk present.
2288 elsif Parent_Nkind = N_Package_Body then
2289 Missing_Begin ("missing BEGIN for package body&#!");
2292 pragma Assert (Parent_Nkind = N_Task_Body);
2293 Missing_Begin ("missing BEGIN for task body&#!");
2296 -- Here we pick up the statements after the BEGIN that
2297 -- should have been present but was not. We don't insist
2298 -- on statements being present if P_Declarative_Part had
2299 -- already found a missing BEGIN, since it might have
2300 -- swallowed a lone statement into the declarative part.
2302 if Missing_Begin_Msg /= No_Error_Msg
2303 and then Token = Tok_End
2307 Set_Handled_Statement_Sequence (Parent,
2308 P_Handled_Sequence_Of_Statements);
2314 -- Here with declarations and handled statement sequence scanned
2316 if Present (Handled_Statement_Sequence (Parent)) then
2317 End_Statements (Handled_Statement_Sequence (Parent));
2322 -- We know that End_Statements removed an entry from the scope stack
2323 -- (because it is required to do so under all circumstances). We can
2324 -- therefore reference the entry it removed one past the stack top.
2325 -- What we are interested in is whether it was a case of a bad IS.
2327 if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
2328 Error_Msg -- CODEFIX
2329 ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
2330 Set_Bad_Is_Detected (Parent, True);
2333 end Parse_Decls_Begin_End;
2335 -------------------------
2336 -- Set_Loop_Block_Name --
2337 -------------------------
2339 function Set_Loop_Block_Name (L : Character) return Name_Id is
2341 Name_Buffer (1) := L;
2342 Name_Buffer (2) := '_';
2344 Loop_Block_Count := Loop_Block_Count + 1;
2345 Add_Nat_To_Name_Buffer (Loop_Block_Count);
2347 end Set_Loop_Block_Name;
2353 procedure Then_Scan is
2357 while Token = Tok_Then loop
2358 Error_Msg_SC -- CODEFIX
2363 if Token = Tok_And or else Token = Tok_Or then
2364 Error_Msg_SC ("unexpected logical operator");
2365 Scan; -- past logical operator
2367 if (Prev_Token = Tok_And and then Token = Tok_Then)
2369 (Prev_Token = Tok_Or and then Token = Tok_Else)
2374 Discard_Junk_Node (P_Expression);
2377 if Token = Tok_Then then