1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2022, 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 by RM
28 -- section rather than alphabetical.
30 with Sinfo
.CN
; use Sinfo
.CN
;
35 -- Local functions, used only in this chapter
37 function P_Case_Statement
return Node_Id
;
38 function P_Case_Statement_Alternative
return Node_Id
;
39 function P_Exit_Statement
return Node_Id
;
40 function P_Goto_Statement
return Node_Id
;
41 function P_If_Statement
return Node_Id
;
42 function P_Label
return Node_Id
;
43 function P_Null_Statement
return Node_Id
;
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).
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.
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.
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.
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.
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.
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.
81 -- Scan past THEN token, testing for illegal junk after it
83 ---------------------------------
84 -- 5.1 Sequence of Statements --
85 ---------------------------------
87 -- SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
88 -- Note: the final label is an Ada 2012 addition.
91 -- {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
93 -- SIMPLE_STATEMENT ::= NULL_STATEMENT
94 -- | ASSIGNMENT_STATEMENT | EXIT_STATEMENT
95 -- | GOTO_STATEMENT | PROCEDURE_CALL_STATEMENT
96 -- | RETURN_STATEMENT | ENTRY_CALL_STATEMENT
97 -- | REQUEUE_STATEMENT | DELAY_STATEMENT
98 -- | ABORT_STATEMENT | RAISE_STATEMENT
101 -- COMPOUND_STATEMENT ::=
102 -- IF_STATEMENT | CASE_STATEMENT
103 -- | LOOP_STATEMENT | BLOCK_STATEMENT
104 -- | ACCEPT_STATEMENT | SELECT_STATEMENT
106 -- This procedure scans a sequence of statements. The caller sets SS_Flags
107 -- to indicate acceptable termination conditions for the sequence:
109 -- SS_Flags.Eftm Terminate on ELSIF
110 -- SS_Flags.Eltm Terminate on ELSE
111 -- SS_Flags.Extm Terminate on EXCEPTION
112 -- SS_Flags.Ortm Terminate on OR
113 -- SS_Flags.Tatm Terminate on THEN ABORT (Token = ABORT on return)
114 -- SS_Flags.Whtm Terminate on WHEN
115 -- SS_Flags.Unco Unconditional terminate after scanning one statement
117 -- In addition, the scan is always terminated by encountering END or the
118 -- end of file (EOF) condition. If one of the six above terminators is
119 -- encountered with the corresponding SS_Flags flag not set, then the
120 -- action taken is as follows:
122 -- If the keyword occurs to the left of the expected column of the end
123 -- for the current sequence (as recorded in the current end context),
124 -- then it is assumed to belong to an outer context, and is considered
125 -- to terminate the sequence of statements.
127 -- If the keyword occurs to the right of, or in the expected column of
128 -- the end for the current sequence, then an error message is output,
129 -- the keyword together with its associated context is skipped, and
130 -- the statement scan continues until another terminator is found.
132 -- Note that the first action means that control can return to the caller
133 -- with Token set to a terminator other than one of those specified by the
134 -- SS parameter. The caller should treat such a case as equivalent to END.
136 -- In addition, the flag SS_Flags.Sreq is set to True to indicate that at
137 -- least one real statement (other than a pragma) is required in the
138 -- statement sequence. During the processing of the sequence, this
139 -- flag is manipulated to indicate the current status of the requirement
140 -- for a statement. For example, it is turned off by the occurrence of a
141 -- statement, and back on by a label (which requires a following statement)
143 -- Error recovery: cannot raise Error_Resync. If an error occurs during
144 -- parsing a statement, then the scan pointer is advanced past the next
145 -- semicolon and the parse continues.
147 function P_Sequence_Of_Statements
148 (SS_Flags
: SS_Rec
; Handled
: Boolean := False) return List_Id
150 Statement_Required
: Boolean;
151 -- This flag indicates if a subsequent statement (other than a pragma)
152 -- is required. It is initialized from the Sreq flag, and modified as
153 -- statements are scanned (a statement turns it off, and a label turns
154 -- it back on again since a statement must follow a label).
155 -- Note : this final requirement is lifted in Ada 2012.
157 Statement_Seen
: Boolean;
158 -- In Ada 2012, a label can end a sequence of statements, but the
159 -- sequence cannot contain only labels. This flag is set whenever a
160 -- label is encountered, to enforce this rule at the end of a sequence.
162 Scan_State_Label
: Saved_Scan_State
;
163 Scan_State
: Saved_Scan_State
;
165 Statement_List
: List_Id
;
166 Block_Label
: Name_Id
;
170 Decl_Loc
, Label_Loc
: Source_Ptr
:= No_Location
;
171 -- Sloc of the first declaration/label encountered, if any.
173 procedure Test_Statement_Required
;
174 -- Flag error if Statement_Required flag set
176 -----------------------------
177 -- Test_Statement_Required --
178 -----------------------------
180 procedure Test_Statement_Required
is
181 function All_Pragmas
return Boolean;
182 -- Return True if statement list is all pragmas
188 function All_Pragmas
return Boolean is
191 S
:= First
(Statement_List
);
192 while Present
(S
) loop
193 if Nkind
(S
) /= N_Pragma
then
203 -- Start of processing for Test_Statement_Required
206 if Statement_Required
then
208 -- Check no statement required after label in Ada 2012, and that
209 -- it is OK to have nothing but pragmas in a statement sequence.
211 if Ada_Version
>= Ada_2012
212 and then not Is_Empty_List
(Statement_List
)
214 ((Nkind
(Last
(Statement_List
)) = N_Label
215 and then Statement_Seen
)
219 Null_Stm
: constant Node_Id
:=
220 Make_Null_Statement
(Token_Ptr
);
222 Set_Comes_From_Source
(Null_Stm
, False);
223 Append_To
(Statement_List
, Null_Stm
);
226 -- If not Ada 2012, or not special case above, and no declaration
227 -- seen (as allowed in Ada 2020), give error message.
229 elsif No
(Decl_Loc
) then
230 Error_Msg_BC
-- CODEFIX
231 ("statement expected");
234 end Test_Statement_Required
;
236 -- Start of processing for P_Sequence_Of_Statements
239 Statement_List
:= New_List
;
240 Statement_Required
:= SS_Flags
.Sreq
;
241 Statement_Seen
:= False;
243 -- In Ada 2022, we allow declarative items to be mixed with
244 -- statements. The loop below alternates between calling
245 -- P_Declarative_Items to parse zero or more declarative items, and
246 -- parsing a statement.
249 Ignore
(Tok_Semicolon
);
252 Num_Statements
: constant Nat
:= List_Length
(Statement_List
);
255 (Statement_List
, Declare_Expression
=> False,
256 In_Spec
=> False, In_Statements
=> True);
258 -- Use the length of the list to determine whether we parsed any
259 -- declarative items. If so, it's an error pre-2022. ???We should
260 -- be calling Error_Msg_Ada_2022_Feature below, to advertise the
261 -- new feature, but that causes a lot of test diffs, so for now,
262 -- we mimic the old "...before begin" message.
264 if List_Length
(Statement_List
) > Num_Statements
then
265 if All_Errors_Mode
or else No
(Decl_Loc
) then
266 Decl_Loc
:= Sloc
(Pick
(Statement_List
, Num_Statements
+ 1));
269 Error_Msg_Ada_2022_Feature
270 ("declarations mixed with statements",
271 Sloc
(Pick
(Statement_List
, Num_Statements
+ 1)));
273 if Ada_Version
< Ada_2022
then
275 ("declarations must come before BEGIN", Decl_Loc
);
284 Style
.Check_Indentation
;
287 -- Deal with reserved identifier (in assignment or call)
289 if Is_Reserved_Identifier
then
290 Save_Scan_State
(Scan_State
); -- at possible bad identifier
291 Scan
; -- and scan past it
293 -- We have an reserved word which is spelled in identifier
294 -- style, so the question is whether it really is intended
295 -- to be an identifier.
298 -- If followed by a semicolon, then it is an identifier,
299 -- with the exception of the cases tested for below.
301 (Token
= Tok_Semicolon
302 and then Prev_Token
/= Tok_Return
303 and then Prev_Token
/= Tok_Null
304 and then Prev_Token
/= Tok_Raise
305 and then Prev_Token
/= Tok_End
306 and then Prev_Token
/= Tok_Exit
)
308 -- If followed by colon, colon-equal, or dot, then we
309 -- definitely have an identifier (could not be reserved)
311 or else Token
= Tok_Colon
312 or else Token
= Tok_Colon_Equal
313 or else Token
= Tok_Dot
315 -- Left paren means we have an identifier except for those
316 -- reserved words that can legitimately be followed by a
320 (Token
= Tok_Left_Paren
321 and then Prev_Token
/= Tok_Case
322 and then Prev_Token
/= Tok_Delay
323 and then Prev_Token
/= Tok_If
324 and then Prev_Token
/= Tok_Elsif
325 and then Prev_Token
/= Tok_Return
326 and then Prev_Token
/= Tok_When
327 and then Prev_Token
/= Tok_While
328 and then Prev_Token
/= Tok_Separate
)
330 -- Here we have an apparent reserved identifier and the
331 -- token past it is appropriate to this usage (and would
332 -- be a definite error if this is not an identifier). What
333 -- we do is to use P_Identifier to fix up the identifier,
334 -- and then fall into the normal processing.
336 Restore_Scan_State
(Scan_State
); -- back to the ID
337 Scan_Reserved_Identifier
(Force_Msg
=> False);
339 -- Not a reserved identifier after all (or at least we can't
340 -- be sure that it is), so reset the scan and continue.
343 Restore_Scan_State
(Scan_State
); -- back to the reserved word
347 -- Now look to see what kind of statement we have
351 -- Case of end or EOF
356 -- These tokens always terminate the statement sequence
358 Test_Statement_Required
;
365 -- Terminate if Eftm set or if the ELSIF is to the left
366 -- of the expected column of the end for this sequence
369 or else Start_Column
< Scopes
(Scope
.Last
).Ecol
371 Test_Statement_Required
;
374 -- Otherwise complain and skip past ELSIF Condition then
377 Error_Msg_SC
("ELSIF not allowed here");
379 Discard_Junk_Node
(P_Expression_No_Right_Paren
);
381 Statement_Required
:= False;
388 -- Terminate if Eltm set or if the else is to the left
389 -- of the expected column of the end for this sequence
392 or else Start_Column
< Scopes
(Scope
.Last
).Ecol
394 Test_Statement_Required
;
397 -- Otherwise complain and skip past else
400 Error_Msg_SC
("ELSE not allowed here");
402 Statement_Required
:= False;
407 when Tok_Exception
=>
408 Test_Statement_Required
;
410 -- If Extm not set and the exception is not to the left of
411 -- the expected column of the end for this sequence, then we
412 -- assume it belongs to the current sequence, even though it
415 if not SS_Flags
.Extm
and then
416 Start_Column
>= Scopes
(Scope
.Last
).Ecol
419 Error_Msg_SC
("exception handler not permitted here");
420 Scan
; -- past EXCEPTION
421 Discard_Junk_List
(Parse_Exception_Handlers
);
424 -- Always return, in the case where we scanned out handlers
425 -- that we did not expect, Parse_Exception_Handlers returned
426 -- with Token being either end or EOF, so we are OK.
434 -- Terminate if Ortm set or if the or is to the left of the
435 -- expected column of the end for this sequence.
438 or else Start_Column
< Scopes
(Scope
.Last
).Ecol
440 Test_Statement_Required
;
443 -- Otherwise complain and skip past or
446 Error_Msg_SC
("OR not allowed here");
448 Statement_Required
:= False;
451 -- Case of THEN (deal also with THEN ABORT)
454 Save_Scan_State
(Scan_State
); -- at THEN
457 -- Terminate if THEN ABORT allowed (ATC case)
459 exit when SS_Flags
.Tatm
and then Token
= Tok_Abort
;
461 -- Otherwise we treat THEN as some kind of mess where we did
462 -- not see the associated IF, but we pick up assuming it had
465 Restore_Scan_State
(Scan_State
); -- to THEN
466 Append_To
(Statement_List
, P_If_Statement
);
467 Statement_Required
:= False;
469 -- Case of WHEN (error because we are not in a case)
474 -- Terminate if Whtm set or if the WHEN is to the left of
475 -- the expected column of the end for this sequence.
478 or else Start_Column
< Scopes
(Scope
.Last
).Ecol
480 Test_Statement_Required
;
483 -- Otherwise complain and skip when Choice {| Choice} =>
486 Error_Msg_SC
("WHEN not allowed here");
488 Discard_Junk_List
(P_Discrete_Choice_List
);
490 Statement_Required
:= False;
493 -- Cases of statements starting with an identifier
495 when Tok_Identifier
=>
498 -- Save scan pointers and line number in case block label
500 Id_Node
:= Token_Node
;
501 Block_Label
:= Token_Name
;
502 Save_Scan_State
(Scan_State_Label
); -- at possible label
505 -- Check for common case of assignment, since it occurs
506 -- frequently, and we want to process it efficiently.
508 if Token
= Tok_Colon_Equal
then
509 Scan
; -- past the colon-equal
510 Append_To
(Statement_List
,
511 P_Assignment_Statement
(Id_Node
));
512 Statement_Required
:= False;
514 -- Check common case of procedure call, another case that
515 -- we want to speed up as much as possible.
517 elsif Token
= Tok_Semicolon
then
518 Change_Name_To_Procedure_Call_Statement
(Id_Node
);
519 Append_To
(Statement_List
, Id_Node
);
520 Scan
; -- past semicolon
521 Statement_Required
:= False;
523 -- Here is the special test for a suspicious label, more
524 -- accurately a suspicious name, which we think perhaps
525 -- should have been a label. If next token is one of
526 -- LOOP, FOR, WHILE, DECLARE, BEGIN, then make an entry
527 -- in the suspicious label table.
529 if Token
= Tok_Loop
or else
530 Token
= Tok_For
or else
531 Token
= Tok_While
or else
532 Token
= Tok_Declare
or else
535 Suspicious_Labels
.Append
536 ((Proc_Call
=> Id_Node
,
537 Semicolon_Loc
=> Prev_Token_Ptr
,
538 Start_Token
=> Token_Ptr
));
541 -- Check for case of "go to" in place of "goto"
543 elsif Token
= Tok_Identifier
544 and then Block_Label
= Name_Go
545 and then Token_Name
= Name_To
547 Error_Msg_SP
-- CODEFIX
548 ("goto is one word");
549 Append_To
(Statement_List
, P_Goto_Statement
);
550 Statement_Required
:= False;
552 -- Check common case of = used instead of :=, just so we
553 -- give a better error message for this special misuse.
555 elsif Token
= Tok_Equal
then
556 T_Colon_Equal
; -- give := expected message
557 Append_To
(Statement_List
,
558 P_Assignment_Statement
(Id_Node
));
559 Statement_Required
:= False;
561 -- Check case of loop label or block label
563 elsif Token
= Tok_Colon
564 or else (Token
in Token_Class_Labeled_Stmt
565 and then not Token_Is_At_Start_Of_Line
)
567 T_Colon
; -- past colon (if there, or msg for missing one)
569 -- Test for more than one label
572 exit when Token
/= Tok_Identifier
;
573 Save_Scan_State
(Scan_State
); -- at second Id
576 if Token
= Tok_Colon
then
578 ("only one label allowed on block or loop");
579 Scan
; -- past colon on extra label
581 -- Use the second label as the "real" label
583 Scan_State_Label
:= Scan_State
;
585 -- We will set Error_name as the Block_Label since
586 -- we really don't know which of the labels might
587 -- be used at the end of the loop or block.
589 Block_Label
:= Error_Name
;
591 -- If Id with no colon, then backup to point to the
592 -- Id and we will issue the message below when we try
593 -- to scan out the statement as some other form.
596 Restore_Scan_State
(Scan_State
); -- to second Id
601 -- Loop_Statement (labeled Loop_Statement)
603 if Token
= Tok_Loop
then
604 Append_To
(Statement_List
,
605 P_Loop_Statement
(Id_Node
));
607 -- While statement (labeled loop statement with WHILE)
609 elsif Token
= Tok_While
then
610 Append_To
(Statement_List
,
611 P_While_Statement
(Id_Node
));
613 -- Declare statement (labeled block statement with
616 elsif Token
= Tok_Declare
then
617 Append_To
(Statement_List
,
618 P_Declare_Statement
(Id_Node
));
620 -- Begin statement (labeled block statement with no
623 elsif Token
= Tok_Begin
then
624 Append_To
(Statement_List
,
625 P_Begin_Statement
(Id_Node
));
627 -- For statement (labeled loop statement with FOR)
629 elsif Token
= Tok_For
then
630 Append_To
(Statement_List
,
631 P_For_Statement
(Id_Node
));
633 -- Otherwise complain we have inappropriate statement
637 ("loop or block statement must follow label");
640 Statement_Required
:= False;
642 -- Here we have an identifier followed by something
643 -- other than a colon, semicolon or assignment symbol.
644 -- The only valid possibility is a name extension symbol
646 elsif Token
in Token_Class_Namext
then
647 Restore_Scan_State
(Scan_State_Label
); -- to Id
650 -- Skip junk right parens in this context
652 Ignore
(Tok_Right_Paren
);
654 -- Check context following call
656 if Token
= Tok_Colon_Equal
then
657 Scan
; -- past colon equal
658 Append_To
(Statement_List
,
659 P_Assignment_Statement
(Name_Node
));
660 Statement_Required
:= False;
662 -- Check common case of = used instead of :=
664 elsif Token
= Tok_Equal
then
665 T_Colon_Equal
; -- give := expected message
666 Append_To
(Statement_List
,
667 P_Assignment_Statement
(Name_Node
));
668 Statement_Required
:= False;
670 -- Check apostrophe cases
672 elsif Token
= Tok_Apostrophe
then
673 Append_To
(Statement_List
,
674 P_Code_Statement
(Name_Node
));
675 Statement_Required
:= False;
677 -- The only other valid item after a name is ; which
678 -- means that the item we just scanned was a call.
680 elsif Token
= Tok_Semicolon
then
681 Change_Name_To_Procedure_Call_Statement
(Name_Node
);
682 Append_To
(Statement_List
, Name_Node
);
683 Scan
; -- past semicolon
684 Statement_Required
:= False;
686 -- A slash following an identifier or a selected
687 -- component in this situation is most likely a period
688 -- (see location of keys on keyboard).
690 elsif Token
= Tok_Slash
691 and then (Nkind
(Name_Node
) = N_Identifier
693 Nkind
(Name_Node
) = N_Selected_Component
)
695 Error_Msg_SC
-- CODEFIX
696 ("""/"" should be "".""");
697 Statement_Required
:= False;
700 -- Else we have a missing semicolon
705 -- Normal processing as though semicolon were present
707 Change_Name_To_Procedure_Call_Statement
(Name_Node
);
708 Append_To
(Statement_List
, Name_Node
);
709 Statement_Required
:= False;
712 -- If junk after identifier, check if identifier is an
713 -- instance of an incorrectly spelled keyword. If so, we
714 -- do nothing. The Bad_Spelling_Of will have reset Token
715 -- to the appropriate keyword, so the next time round the
716 -- loop we will process the modified token. Note that we
717 -- check for ELSIF before ELSE here. That's not accidental.
718 -- We don't want to identify a misspelling of ELSE as
719 -- ELSIF, and in particular we do not want to treat ELSEIF
723 Restore_Scan_State
(Scan_State_Label
); -- to identifier
725 if Bad_Spelling_Of
(Tok_Abort
)
726 or else Bad_Spelling_Of
(Tok_Accept
)
727 or else Bad_Spelling_Of
(Tok_Case
)
728 or else Bad_Spelling_Of
(Tok_Declare
)
729 or else Bad_Spelling_Of
(Tok_Delay
)
730 or else Bad_Spelling_Of
(Tok_Elsif
)
731 or else Bad_Spelling_Of
(Tok_Else
)
732 or else Bad_Spelling_Of
(Tok_End
)
733 or else Bad_Spelling_Of
(Tok_Exception
)
734 or else Bad_Spelling_Of
(Tok_Exit
)
735 or else Bad_Spelling_Of
(Tok_For
)
736 or else Bad_Spelling_Of
(Tok_Goto
)
737 or else Bad_Spelling_Of
(Tok_If
)
738 or else Bad_Spelling_Of
(Tok_Loop
)
739 or else Bad_Spelling_Of
(Tok_Or
)
740 or else Bad_Spelling_Of
(Tok_Pragma
)
741 or else Bad_Spelling_Of
(Tok_Raise
)
742 or else Bad_Spelling_Of
(Tok_Requeue
)
743 or else Bad_Spelling_Of
(Tok_Return
)
744 or else Bad_Spelling_Of
(Tok_Select
)
745 or else Bad_Spelling_Of
(Tok_When
)
746 or else Bad_Spelling_Of
(Tok_While
)
750 -- If not a bad spelling, then we really have junk
753 Scan
; -- past identifier again
755 -- If next token is first token on line, then we
756 -- consider that we were missing a semicolon after
757 -- the identifier, and process it as a procedure
758 -- call with no parameters.
760 if Token_Is_At_Start_Of_Line
then
761 Change_Name_To_Procedure_Call_Statement
(Id_Node
);
762 Append_To
(Statement_List
, Id_Node
);
763 T_Semicolon
; -- to give error message
764 Statement_Required
:= False;
766 -- Otherwise we give a missing := message and
767 -- simply abandon the junk that is there now.
770 T_Colon_Equal
; -- give := expected message
777 -- Statement starting with operator symbol. This could be
778 -- a call, a name starting an assignment, or a qualified
781 when Tok_Operator_Symbol
=>
785 -- An attempt at a range attribute or a qualified expression
786 -- must be illegal here (a code statement cannot possibly
787 -- allow qualification by a function name).
789 if Token
= Tok_Apostrophe
then
790 Error_Msg_SC
("apostrophe illegal here");
794 -- Scan possible assignment if we have a name
796 if Expr_Form
= EF_Name
797 and then Token
= Tok_Colon_Equal
799 Scan
; -- past colon equal
800 Append_To
(Statement_List
,
801 P_Assignment_Statement
(Name_Node
));
803 Change_Name_To_Procedure_Call_Statement
(Name_Node
);
804 Append_To
(Statement_List
, Name_Node
);
808 Statement_Required
:= False;
810 -- Label starting with << which must precede real statement
811 -- Note: in Ada 2012, the label may end the sequence.
813 when Tok_Less_Less
=>
814 if Present
(Last
(Statement_List
))
815 and then Nkind
(Last
(Statement_List
)) /= N_Label
817 Statement_Seen
:= True;
820 Append_To
(Statement_List
, P_Label
);
821 Statement_Required
:= True;
823 if No
(Label_Loc
) then
824 Label_Loc
:= Sloc
(Last
(Statement_List
));
827 -- Pragma appearing as a statement in a statement sequence
831 Append_To
(Statement_List
, P_Pragma
);
837 Append_To
(Statement_List
, P_Abort_Statement
);
838 Statement_Required
:= False;
844 Append_To
(Statement_List
, P_Accept_Statement
);
845 Statement_Required
:= False;
847 -- Begin_Statement (Block_Statement with no declare, no label)
851 Append_To
(Statement_List
, P_Begin_Statement
);
852 Statement_Required
:= False;
858 Append_To
(Statement_List
, P_Case_Statement
);
859 Statement_Required
:= False;
861 -- Block_Statement with DECLARE and no label
865 Append_To
(Statement_List
, P_Declare_Statement
);
866 Statement_Required
:= False;
872 Append_To
(Statement_List
, P_Delay_Statement
);
873 Statement_Required
:= False;
879 Append_To
(Statement_List
, P_Exit_Statement
);
880 Statement_Required
:= False;
882 -- Loop_Statement with FOR and no label
886 Append_To
(Statement_List
, P_For_Statement
);
887 Statement_Required
:= False;
893 Append_To
(Statement_List
, P_Goto_Statement
);
894 Statement_Required
:= False;
900 Append_To
(Statement_List
, P_If_Statement
);
901 Statement_Required
:= False;
907 Append_To
(Statement_List
, P_Loop_Statement
);
908 Statement_Required
:= False;
914 Append_To
(Statement_List
, P_Null_Statement
);
915 Statement_Required
:= False;
921 Append_To
(Statement_List
, P_Raise_Statement
);
922 Statement_Required
:= False;
928 Append_To
(Statement_List
, P_Requeue_Statement
);
929 Statement_Required
:= False;
935 Append_To
(Statement_List
, P_Return_Statement
);
936 Statement_Required
:= False;
942 Append_To
(Statement_List
, P_Select_Statement
);
943 Statement_Required
:= False;
945 -- While_Statement (Block_Statement with while and no loop)
949 Append_To
(Statement_List
, P_While_Statement
);
950 Statement_Required
:= False;
952 -- Anything else is some kind of junk, signal an error message
953 -- and then raise Error_Resync, to merge with the normal
954 -- handling of a bad statement.
957 Error_Msg_BC
-- CODEFIX
958 ("statement expected");
962 -- On error resynchronization, skip past next semicolon, and, since
963 -- we are still in the statement loop, look for next statement. We
964 -- set Statement_Required False to avoid an unnecessary error message
965 -- complaining that no statement was found (i.e. we consider the
966 -- junk to satisfy the requirement for a statement being present).
970 Resync_Past_Semicolon_Or_To_Loop_Or_Then
;
971 Statement_Required
:= False;
974 exit when SS_Flags
.Unco
;
977 -- If there are no declarative items in the list, or if the list is part
978 -- of a handled sequence of statements, we just return the list.
979 -- Otherwise, we wrap the list in a block statement, so the declarations
980 -- will have a proper scope. In the Handled case, it would be wrong to
981 -- wrap, because we want the code before and after "begin" to be in the
982 -- same scope. Example:
986 -- Do_Something (...);
989 -- is tranformed into:
994 -- Do_Something (...);
998 -- But we don't wrap this:
1005 -- Otherwise, we would fail to detect the error (conflicting X's).
1006 -- Similarly, if a representation clause appears in the statement
1007 -- part, we don't want it to appear more nested than the declarative
1008 -- part -- that would cause an unwanted error.
1010 if Present
(Decl_Loc
) then
1011 -- Forbid labels and declarative items from coexisting. Otherwise,
1012 -- one could jump past a declaration, leading to chaos. Jumping
1013 -- backward past a declaration is also questionable -- does the
1014 -- declaration get elaborated again? Is secondary stack storage
1015 -- reclaimed? (A more liberal rule was proposed, but this is what
1016 -- we're doing for now.)
1018 if Present
(Label_Loc
) then
1019 Error_Msg
("declarative item in same list as label", Decl_Loc
);
1020 Error_Msg
("label in same list as declarative item", Label_Loc
);
1023 -- Forbid exception handlers and declarative items from
1024 -- coexisting. Example:
1026 -- X : Integer := 123;
1029 -- X : Integer := 456;
1035 -- It was proposed that in the handler, X should refer to the outer
1036 -- X, but that's just confusing.
1038 if Token
= Tok_Exception
then
1040 ("declarative item in statements conflicts with " &
1041 "exception handler below",
1044 ("exception handler conflicts with " &
1045 "declarative item in statements above",
1050 return Statement_List
;
1053 Loc
: constant Source_Ptr
:= Sloc
(First
(Statement_List
));
1054 Block
: constant Node_Id
:=
1055 Make_Block_Statement
1057 Handled_Statement_Sequence
=>
1058 Make_Handled_Sequence_Of_Statements
1059 (Loc
, Statements
=> Statement_List
));
1061 return New_List
(Block
);
1065 return Statement_List
;
1067 end P_Sequence_Of_Statements
;
1069 --------------------
1071 --------------------
1073 ---------------------------
1074 -- 5.1 Simple Statement --
1075 ---------------------------
1077 -- Parsed by P_Sequence_Of_Statements (5.1)
1079 -----------------------------
1080 -- 5.1 Compound Statement --
1081 -----------------------------
1083 -- Parsed by P_Sequence_Of_Statements (5.1)
1085 -------------------------
1086 -- 5.1 Null Statement --
1087 -------------------------
1089 -- NULL_STATEMENT ::= null;
1091 -- The caller has already checked that the current token is null
1093 -- Error recovery: cannot raise Error_Resync
1095 function P_Null_Statement
return Node_Id
is
1096 Null_Stmt_Node
: Node_Id
;
1099 Null_Stmt_Node
:= New_Node
(N_Null_Statement
, Token_Ptr
);
1102 return Null_Stmt_Node
;
1103 end P_Null_Statement
;
1109 -- LABEL ::= <<label_STATEMENT_IDENTIFIER>>
1111 -- STATEMENT_IDENTIFIER ::= DIRECT_NAME
1113 -- The IDENTIFIER of a STATEMENT_IDENTIFIER shall be an identifier
1114 -- (not an OPERATOR_SYMBOL)
1116 -- The caller has already checked that the current token is <<
1118 -- Error recovery: can raise Error_Resync
1120 function P_Label
return Node_Id
is
1121 Label_Node
: Node_Id
;
1124 Label_Node
:= New_Node
(N_Label
, Token_Ptr
);
1126 Set_Identifier
(Label_Node
, P_Identifier
(C_Greater_Greater
));
1128 Append_Elmt
(Label_Node
, Label_List
);
1132 -------------------------------
1133 -- 5.1 Statement Identifier --
1134 -------------------------------
1136 -- Statement label is parsed by P_Label (5.1)
1138 -- Loop label is parsed by P_Loop_Statement (5.5), P_For_Statement (5.5)
1139 -- or P_While_Statement (5.5)
1141 -- Block label is parsed by P_Begin_Statement (5.6) or
1142 -- P_Declare_Statement (5.6)
1144 -------------------------------
1145 -- 5.2 Assignment Statement --
1146 -------------------------------
1148 -- ASSIGNMENT_STATEMENT ::=
1149 -- variable_NAME := EXPRESSION;
1151 -- Error recovery: can raise Error_Resync
1153 function P_Assignment_Statement
(LHS
: Node_Id
) return Node_Id
is
1154 Assign_Node
: Node_Id
;
1157 Assign_Node
:= New_Node
(N_Assignment_Statement
, Prev_Token_Ptr
);
1158 Current_Assign_Node
:= Assign_Node
;
1159 Set_Name
(Assign_Node
, LHS
);
1160 Set_Expression
(Assign_Node
, P_Expression_No_Right_Paren
);
1162 Current_Assign_Node
:= Empty
;
1164 end P_Assignment_Statement
;
1166 -----------------------
1167 -- 5.3 If Statement --
1168 -----------------------
1171 -- if CONDITION then
1172 -- SEQUENCE_OF_STATEMENTS
1173 -- {elsif CONDITION then
1174 -- SEQUENCE_OF_STATEMENTS}
1176 -- SEQUENCE_OF_STATEMENTS]
1179 -- The caller has checked that the initial token is IF (or in the error
1180 -- case of a mysterious THEN, the initial token may simply be THEN, in
1181 -- which case, no condition (or IF) was scanned).
1183 -- Error recovery: can raise Error_Resync
1185 function P_If_Statement
return Node_Id
is
1187 Elsif_Node
: Node_Id
;
1190 procedure Add_Elsif_Part
;
1191 -- An internal procedure used to scan out a single ELSIF part. On entry
1192 -- the ELSIF (or an ELSE which has been determined should be ELSIF) is
1193 -- scanned out and is in Prev_Token.
1195 procedure Check_If_Column
;
1196 -- An internal procedure used to check that THEN, ELSE, or ELSIF
1197 -- appear in the right place if column checking is enabled (i.e. if
1198 -- they are the first token on the line, then they must appear in
1199 -- the same column as the opening IF).
1201 procedure Check_Then_Column
;
1202 -- This procedure carries out the style checks for a THEN token
1203 -- Note that the caller has set Loc to the Source_Ptr value for
1204 -- the previous IF or ELSIF token.
1206 function Else_Should_Be_Elsif
return Boolean;
1207 -- An internal routine used to do a special error recovery check when
1208 -- an ELSE is encountered. It determines if the ELSE should be treated
1209 -- as an ELSIF. A positive decision (TRUE returned, is made if the ELSE
1210 -- is followed by a sequence of tokens, starting on the same line as
1211 -- the ELSE, which are not expression terminators, followed by a THEN.
1212 -- On entry, the ELSE has been scanned out.
1214 procedure Add_Elsif_Part
is
1216 if No
(Elsif_Parts
(If_Node
)) then
1217 Set_Elsif_Parts
(If_Node
, New_List
);
1220 Elsif_Node
:= New_Node
(N_Elsif_Part
, Prev_Token_Ptr
);
1221 Loc
:= Prev_Token_Ptr
;
1222 Set_Condition
(Elsif_Node
, P_Condition
);
1226 (Elsif_Node
, P_Sequence_Of_Statements
(SS_Eftm_Eltm_Sreq
));
1227 Append
(Elsif_Node
, Elsif_Parts
(If_Node
));
1230 procedure Check_If_Column
is
1232 if RM_Column_Check
and then Token_Is_At_Start_Of_Line
1233 and then Start_Column
/= Scopes
(Scope
.Last
).Ecol
1235 Error_Msg_Col
:= Scopes
(Scope
.Last
).Ecol
;
1236 Error_Msg_SC
("(style) this token should be@");
1238 end Check_If_Column
;
1240 procedure Check_Then_Column
is
1242 if Token
= Tok_Then
then
1246 Style
.Check_Then
(Loc
);
1249 end Check_Then_Column
;
1251 function Else_Should_Be_Elsif
return Boolean is
1252 Scan_State
: Saved_Scan_State
;
1255 if Token_Is_At_Start_Of_Line
then
1259 Save_Scan_State
(Scan_State
);
1262 if Token
in Token_Class_Eterm
then
1263 Restore_Scan_State
(Scan_State
);
1266 Scan
; -- past non-expression terminating token
1268 if Token
= Tok_Then
then
1269 Restore_Scan_State
(Scan_State
);
1275 end Else_Should_Be_Elsif
;
1277 -- Start of processing for P_If_Statement
1280 If_Node
:= New_Node
(N_If_Statement
, Token_Ptr
);
1283 Scopes
(Scope
.Last
).Etyp
:= E_If
;
1284 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1285 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1286 Scopes
(Scope
.Last
).Labl
:= Error
;
1287 Scopes
(Scope
.Last
).Node
:= If_Node
;
1289 if Token
= Tok_If
then
1292 Set_Condition
(If_Node
, P_Condition
);
1294 -- Deal with misuse of IF expression => used instead
1295 -- of WHEN expression =>
1297 if Token
= Tok_Arrow
then
1298 Error_Msg_SC
-- CODEFIX
1300 Scan
; -- past the arrow
1301 Pop_Scope_Stack
; -- remove unneeded entry
1308 Error_Msg_SC
("no IF for this THEN");
1309 Set_Condition
(If_Node
, Error
);
1315 (If_Node
, P_Sequence_Of_Statements
(SS_Eftm_Eltm_Sreq
));
1317 -- This loop scans out else and elsif parts
1320 if Token
= Tok_Elsif
then
1323 if Present
(Else_Statements
(If_Node
)) then
1324 Error_Msg_SP
("ELSIF cannot appear after ELSE");
1330 elsif Token
= Tok_Else
then
1334 if Else_Should_Be_Elsif
then
1335 Error_Msg_SP
-- CODEFIX
1336 ("ELSE should be ELSIF");
1340 -- Here we have an else that really is an else
1342 if Present
(Else_Statements
(If_Node
)) then
1343 Error_Msg_SP
("only one ELSE part allowed");
1345 (P_Sequence_Of_Statements
(SS_Eftm_Eltm_Sreq
),
1346 Else_Statements
(If_Node
));
1349 (If_Node
, P_Sequence_Of_Statements
(SS_Eftm_Eltm_Sreq
));
1353 -- If anything other than ELSE or ELSIF, exit the loop. The token
1354 -- had better be END (and in fact it had better be END IF), but
1355 -- we will let End_Statements take care of checking that.
1367 --------------------
1369 --------------------
1371 -- CONDITION ::= boolean_EXPRESSION
1373 function P_Condition
return Node_Id
is
1375 return P_Condition
(P_Expression_No_Right_Paren
);
1378 function P_Condition
(Cond
: Node_Id
) return Node_Id
is
1380 -- It is never possible for := to follow a condition, so if we get
1381 -- a := we assume it is a mistyped equality. Note that we do not try
1382 -- to reconstruct the tree correctly in this case, but we do at least
1383 -- give an accurate error message.
1385 if Token
= Tok_Colon_Equal
then
1386 while Token
= Tok_Colon_Equal
loop
1387 Error_Msg_SC
-- CODEFIX
1388 (""":="" should be ""=""");
1389 Scan
; -- past junk :=
1390 Discard_Junk_Node
(P_Expression_No_Right_Paren
);
1395 -- Otherwise check for redundant parentheses but do not emit messages
1396 -- about expressions that require parentheses (e.g. conditional,
1397 -- quantified or declaration expressions).
1402 Paren_Count
(Cond
) >
1403 (if Nkind
(Cond
) in N_Case_Expression
1404 | N_Expression_With_Actions
1406 | N_Quantified_Expression
1410 Style
.Check_Xtra_Parens
(First_Sloc
(Cond
));
1413 -- And return the result
1419 -------------------------
1420 -- 5.4 Case Statement --
1421 -------------------------
1423 -- CASE_STATEMENT ::=
1424 -- case EXPRESSION is
1425 -- CASE_STATEMENT_ALTERNATIVE
1426 -- {CASE_STATEMENT_ALTERNATIVE}
1429 -- The caller has checked that the first token is CASE
1431 -- Can raise Error_Resync
1433 function P_Case_Statement
return Node_Id
is
1434 Case_Node
: Node_Id
;
1435 Alternatives_List
: List_Id
;
1436 First_When_Loc
: Source_Ptr
;
1439 Case_Node
:= New_Node
(N_Case_Statement
, Token_Ptr
);
1442 Scopes
(Scope
.Last
).Etyp
:= E_Case
;
1443 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1444 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1445 Scopes
(Scope
.Last
).Labl
:= Error
;
1446 Scopes
(Scope
.Last
).Node
:= Case_Node
;
1449 Set_Expression
(Case_Node
, P_Expression_No_Right_Paren
);
1452 -- Prepare to parse case statement alternatives
1454 Alternatives_List
:= New_List
;
1455 P_Pragmas_Opt
(Alternatives_List
);
1456 First_When_Loc
:= Token_Ptr
;
1458 -- Loop through case statement alternatives
1461 -- If we have a WHEN or OTHERS, then that's fine keep going. Note
1462 -- that it is a semantic check to ensure the proper use of OTHERS
1464 if Token
= Tok_When
or else Token
= Tok_Others
then
1465 Append
(P_Case_Statement_Alternative
, Alternatives_List
);
1467 -- If we have an END, then probably we are at the end of the case
1468 -- but we only exit if Check_End thinks the END was reasonable.
1470 elsif Token
= Tok_End
then
1471 exit when Check_End
;
1473 -- Here if token is other than WHEN, OTHERS or END. We definitely
1474 -- have an error, but the question is whether or not to get out of
1475 -- the case statement. We don't want to get out early, or we will
1476 -- get a slew of junk error messages for subsequent when tokens.
1478 -- If the token is not at the start of the line, or if it is indented
1479 -- with respect to the current case statement, then the best guess is
1480 -- that we are still supposed to be inside the case statement. We
1481 -- complain about the missing WHEN, and discard the junk statements.
1483 elsif not Token_Is_At_Start_Of_Line
1484 or else Start_Column
> Scopes
(Scope
.Last
).Ecol
1486 Error_Msg_BC
("WHEN (case statement alternative) expected");
1488 -- Here is a possibility for infinite looping if we don't make
1489 -- progress. So try to process statements, otherwise exit
1492 Error_Ptr
: constant Source_Ptr
:= Scan_Ptr
;
1494 Discard_Junk_List
(P_Sequence_Of_Statements
(SS_Whtm
));
1495 exit when Scan_Ptr
= Error_Ptr
and then Check_End
;
1498 -- Here we have a junk token at the start of the line and it is
1499 -- not indented. If Check_End thinks there is a missing END, then
1500 -- we will get out of the case, otherwise we keep going.
1503 exit when Check_End
;
1507 -- Make sure we have at least one alternative
1509 if No
(First_Non_Pragma
(Alternatives_List
)) then
1511 ("WHEN expected, must have at least one alternative in case",
1516 Set_Alternatives
(Case_Node
, Alternatives_List
);
1519 end P_Case_Statement
;
1521 -------------------------------------
1522 -- 5.4 Case Statement Alternative --
1523 -------------------------------------
1525 -- CASE_STATEMENT_ALTERNATIVE ::=
1526 -- when DISCRETE_CHOICE_LIST =>
1527 -- SEQUENCE_OF_STATEMENTS
1529 -- The caller has checked that the initial token is WHEN or OTHERS
1530 -- Error recovery: can raise Error_Resync
1532 function P_Case_Statement_Alternative
return Node_Id
is
1533 Case_Alt_Node
: Node_Id
;
1537 Style
.Check_Indentation
;
1540 Case_Alt_Node
:= New_Node
(N_Case_Statement_Alternative
, Token_Ptr
);
1541 T_When
; -- past WHEN (or give error in OTHERS case)
1542 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
1544 Set_Statements
(Case_Alt_Node
, P_Sequence_Of_Statements
(SS_Sreq_Whtm
));
1545 return Case_Alt_Node
;
1546 end P_Case_Statement_Alternative
;
1548 -------------------------
1549 -- 5.5 Loop Statement --
1550 -------------------------
1552 -- LOOP_STATEMENT ::=
1553 -- [LOOP_STATEMENT_IDENTIFIER:]
1554 -- [ITERATION_SCHEME] loop
1555 -- SEQUENCE_OF_STATEMENTS
1556 -- end loop [loop_IDENTIFIER];
1558 -- ITERATION_SCHEME ::=
1560 -- | for LOOP_PARAMETER_SPECIFICATION
1562 -- The parsing of loop statements is handled by one of three functions
1563 -- P_Loop_Statement, P_For_Statement or P_While_Statement depending
1564 -- on the initial keyword in the construct (excluding the identifier)
1568 -- This function parses the case where no iteration scheme is present
1570 -- The caller has checked that the initial token is LOOP. The parameter
1571 -- is the node identifiers for the loop label if any (or is set to Empty
1572 -- if there is no loop label).
1574 -- Error recovery : cannot raise Error_Resync
1576 function P_Loop_Statement
(Loop_Name
: Node_Id
:= Empty
) return Node_Id
is
1577 Loop_Node
: Node_Id
;
1578 Created_Name
: Node_Id
;
1582 Scopes
(Scope
.Last
).Labl
:= Loop_Name
;
1583 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1584 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1585 Scopes
(Scope
.Last
).Etyp
:= E_Loop
;
1587 Loop_Node
:= New_Node
(N_Loop_Statement
, Token_Ptr
);
1590 if No
(Loop_Name
) then
1592 Make_Identifier
(Sloc
(Loop_Node
), Set_Loop_Block_Name
('L'));
1593 Set_Comes_From_Source
(Created_Name
, False);
1594 Set_Has_Created_Identifier
(Loop_Node
, True);
1595 Set_Identifier
(Loop_Node
, Created_Name
);
1596 Scopes
(Scope
.Last
).Labl
:= Created_Name
;
1598 Set_Identifier
(Loop_Node
, Loop_Name
);
1601 Append_Elmt
(Loop_Node
, Label_List
);
1602 Set_Statements
(Loop_Node
, P_Sequence_Of_Statements
(SS_Sreq
));
1603 End_Statements
(Loop_Node
);
1605 end P_Loop_Statement
;
1609 -- This function parses a loop statement with a FOR iteration scheme
1611 -- The caller has checked that the initial token is FOR. The parameter
1612 -- is the node identifier for the block label if any (or is set to Empty
1613 -- if there is no block label).
1615 -- Note: the caller fills in the Identifier field if a label was present
1617 -- Error recovery: can raise Error_Resync
1619 function P_For_Statement
(Loop_Name
: Node_Id
:= Empty
) return Node_Id
is
1620 Loop_Node
: Node_Id
;
1621 Iter_Scheme_Node
: Node_Id
;
1622 Loop_For_Flag
: Boolean;
1623 Created_Name
: Node_Id
;
1628 Scopes
(Scope
.Last
).Labl
:= Loop_Name
;
1629 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1630 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1631 Scopes
(Scope
.Last
).Etyp
:= E_Loop
;
1633 Loop_For_Flag
:= (Prev_Token
= Tok_Loop
);
1635 Iter_Scheme_Node
:= New_Node
(N_Iteration_Scheme
, Token_Ptr
);
1636 Spec
:= P_Loop_Parameter_Specification
;
1638 if Nkind
(Spec
) = N_Loop_Parameter_Specification
then
1639 Set_Loop_Parameter_Specification
(Iter_Scheme_Node
, Spec
);
1641 Set_Iterator_Specification
(Iter_Scheme_Node
, Spec
);
1644 -- The following is a special test so that a miswritten for loop such
1645 -- as "loop for I in 1..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_For_Flag
and then Token
= Tok_Semicolon
then
1652 Error_Msg_SC
("LOOP belongs here, not before FOR");
1659 Loop_Node
:= New_Node
(N_Loop_Statement
, Token_Ptr
);
1661 if No
(Loop_Name
) then
1663 Make_Identifier
(Sloc
(Loop_Node
), Set_Loop_Block_Name
('L'));
1664 Set_Comes_From_Source
(Created_Name
, False);
1665 Set_Has_Created_Identifier
(Loop_Node
, True);
1666 Set_Identifier
(Loop_Node
, Created_Name
);
1667 Scopes
(Scope
.Last
).Labl
:= Created_Name
;
1669 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_For_Statement
;
1681 -- P_While_Statement
1683 -- This procedure scans a loop statement with a WHILE iteration scheme
1685 -- The caller has checked that the initial token is WHILE. The parameter
1686 -- is the node identifier for the block label if any (or is set to Empty
1687 -- if there is no block label).
1689 -- Error recovery: cannot raise Error_Resync
1691 function P_While_Statement
(Loop_Name
: Node_Id
:= Empty
) return Node_Id
is
1692 Loop_Node
: Node_Id
;
1693 Iter_Scheme_Node
: Node_Id
;
1694 Loop_While_Flag
: Boolean;
1695 Created_Name
: Node_Id
;
1699 Scopes
(Scope
.Last
).Labl
:= Loop_Name
;
1700 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1701 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1702 Scopes
(Scope
.Last
).Etyp
:= E_Loop
;
1704 Loop_While_Flag
:= (Prev_Token
= Tok_Loop
);
1705 Iter_Scheme_Node
:= New_Node
(N_Iteration_Scheme
, Token_Ptr
);
1707 Set_Condition
(Iter_Scheme_Node
, P_Condition
);
1709 -- The following is a special test so that a miswritten for loop such
1710 -- as "loop while I > 10;" is handled nicely, without making an extra
1711 -- entry in the scope stack. We don't bother to actually fix up the
1712 -- tree in this case since it's not worth the effort. Instead we just
1713 -- eat up the loop junk, leaving the entry for what now looks like an
1714 -- unmodified loop intact.
1716 if Loop_While_Flag
and then Token
= Tok_Semicolon
then
1717 Error_Msg_SC
("LOOP belongs here, not before WHILE");
1724 Loop_Node
:= New_Node
(N_Loop_Statement
, Token_Ptr
);
1727 if No
(Loop_Name
) then
1729 Make_Identifier
(Sloc
(Loop_Node
), Set_Loop_Block_Name
('L'));
1730 Set_Comes_From_Source
(Created_Name
, False);
1731 Set_Has_Created_Identifier
(Loop_Node
, True);
1732 Set_Identifier
(Loop_Node
, Created_Name
);
1733 Scopes
(Scope
.Last
).Labl
:= Created_Name
;
1735 Set_Identifier
(Loop_Node
, Loop_Name
);
1738 Set_Statements
(Loop_Node
, P_Sequence_Of_Statements
(SS_Sreq
));
1739 End_Statements
(Loop_Node
);
1740 Set_Iteration_Scheme
(Loop_Node
, Iter_Scheme_Node
);
1741 Append_Elmt
(Loop_Node
, Label_List
);
1744 end P_While_Statement
;
1746 ---------------------------------------
1747 -- 5.5 Loop Parameter Specification --
1748 ---------------------------------------
1750 -- LOOP_PARAMETER_SPECIFICATION ::=
1751 -- DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
1752 -- [Iterator_Filter]
1754 -- Error recovery: cannot raise Error_Resync
1756 function P_Loop_Parameter_Specification
return Node_Id
is
1757 Loop_Param_Specification_Node
: Node_Id
;
1760 Scan_State
: Saved_Scan_State
;
1764 Save_Scan_State
(Scan_State
);
1765 ID_Node
:= P_Defining_Identifier
(C_In
);
1767 -- If the next token is OF, it indicates an Ada 2012 iterator. If the
1768 -- next token is a colon, this is also an Ada 2012 iterator, including
1769 -- a subtype indication for the loop parameter. Otherwise we parse the
1770 -- construct as a loop parameter specification. Note that the form
1771 -- "for A in B" is ambiguous, and must be resolved semantically: if B
1772 -- is a discrete subtype this is a loop specification, but if it is an
1773 -- expression it is an iterator specification. Ambiguity is resolved
1774 -- during analysis of the loop parameter specification.
1776 if Token
= Tok_Of
or else Token
= Tok_Colon
then
1777 Error_Msg_Ada_2012_Feature
("iterator", Token_Ptr
);
1778 return P_Iterator_Specification
(ID_Node
);
1781 -- The span of the Loop_Parameter_Specification starts at the
1782 -- defining identifier.
1784 Loop_Param_Specification_Node
:=
1785 New_Node
(N_Loop_Parameter_Specification
, Sloc
(ID_Node
));
1786 Set_Defining_Identifier
(Loop_Param_Specification_Node
, ID_Node
);
1788 if Token
= Tok_Left_Paren
then
1789 Error_Msg_SC
("subscripted loop parameter not allowed");
1790 Restore_Scan_State
(Scan_State
);
1791 Discard_Junk_Node
(P_Name
);
1793 elsif Token
= Tok_Dot
then
1794 Error_Msg_SC
("selected loop parameter not allowed");
1795 Restore_Scan_State
(Scan_State
);
1796 Discard_Junk_Node
(P_Name
);
1801 if Token
= Tok_Reverse
then
1802 Scan
; -- past REVERSE
1803 Set_Reverse_Present
(Loop_Param_Specification_Node
, True);
1806 Set_Discrete_Subtype_Definition
1807 (Loop_Param_Specification_Node
, P_Discrete_Subtype_Definition
);
1809 if Token
= Tok_When
then
1810 Error_Msg_Ada_2022_Feature
("iterator filter", Token_Ptr
);
1814 (Loop_Param_Specification_Node
, P_Condition
);
1817 return Loop_Param_Specification_Node
;
1820 when Error_Resync
=>
1822 end P_Loop_Parameter_Specification
;
1824 ----------------------------------
1825 -- 5.5.1 Iterator_Specification --
1826 ----------------------------------
1828 function P_Iterator_Specification
(Def_Id
: Node_Id
) return Node_Id
is
1832 Node1
:= New_Node
(N_Iterator_Specification
, Sloc
(Def_Id
));
1833 Set_Defining_Identifier
(Node1
, Def_Id
);
1835 if Token
= Tok_Colon
then
1838 if Token
= Tok_Access
then
1839 Error_Msg_Ada_2022_Feature
1840 ("access definition in loop parameter", Token_Ptr
);
1841 Set_Subtype_Indication
(Node1
, P_Access_Definition
(False));
1844 Set_Subtype_Indication
(Node1
, P_Subtype_Indication
);
1848 if Token
= Tok_Of
then
1849 Set_Of_Present
(Node1
);
1852 elsif Token
= Tok_In
then
1855 elsif Prev_Token
= Tok_In
1856 and then Present
(Subtype_Indication
(Node1
))
1858 -- Simplest recovery is to transform it into an element iterator.
1859 -- Error message on 'in" has already been emitted when parsing the
1860 -- optional constraint.
1862 Set_Of_Present
(Node1
);
1864 ("subtype indication is only legal on an element iterator",
1865 Subtype_Indication
(Node1
));
1871 if Token
= Tok_Reverse
then
1872 Scan
; -- past REVERSE
1873 Set_Reverse_Present
(Node1
, True);
1876 Set_Name
(Node1
, P_Name
);
1878 if Token
= Tok_When
then
1879 Error_Msg_Ada_2022_Feature
("iterator filter", Token_Ptr
);
1883 (Node1
, P_Condition
);
1887 end P_Iterator_Specification
;
1889 --------------------------
1890 -- 5.6 Block Statement --
1891 --------------------------
1893 -- BLOCK_STATEMENT ::=
1894 -- [block_STATEMENT_IDENTIFIER:]
1896 -- DECLARATIVE_PART]
1898 -- HANDLED_SEQUENCE_OF_STATEMENTS
1899 -- end [block_IDENTIFIER];
1901 -- The parsing of block statements is handled by one of the two functions
1902 -- P_Declare_Statement or P_Begin_Statement depending on whether or not
1903 -- a declare section is present
1905 -- P_Declare_Statement
1907 -- This function parses a block statement with DECLARE present
1909 -- The caller has checked that the initial token is DECLARE
1911 -- Error recovery: cannot raise Error_Resync
1913 function P_Declare_Statement
1914 (Block_Name
: Node_Id
:= Empty
)
1917 Block_Node
: Node_Id
;
1918 Created_Name
: Node_Id
;
1921 Block_Node
:= New_Node
(N_Block_Statement
, Token_Ptr
);
1924 Scopes
(Scope
.Last
).Etyp
:= E_Name
;
1925 Scopes
(Scope
.Last
).Lreq
:= Present
(Block_Name
);
1926 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1927 Scopes
(Scope
.Last
).Labl
:= Block_Name
;
1928 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1930 Scan
; -- past DECLARE
1932 if No
(Block_Name
) then
1934 Make_Identifier
(Sloc
(Block_Node
), Set_Loop_Block_Name
('B'));
1935 Set_Comes_From_Source
(Created_Name
, False);
1936 Set_Has_Created_Identifier
(Block_Node
, True);
1937 Set_Identifier
(Block_Node
, Created_Name
);
1938 Scopes
(Scope
.Last
).Labl
:= Created_Name
;
1940 Set_Identifier
(Block_Node
, Block_Name
);
1943 Append_Elmt
(Block_Node
, Label_List
);
1944 Parse_Decls_Begin_End
(Block_Node
);
1946 end P_Declare_Statement
;
1948 -- P_Begin_Statement
1950 -- This function parses a block statement with no DECLARE present
1952 -- The caller has checked that the initial token is BEGIN
1954 -- Error recovery: cannot raise Error_Resync
1956 function P_Begin_Statement
1957 (Block_Name
: Node_Id
:= Empty
)
1960 Block_Node
: Node_Id
;
1961 Created_Name
: Node_Id
;
1964 Block_Node
:= New_Node
(N_Block_Statement
, Token_Ptr
);
1967 Scopes
(Scope
.Last
).Etyp
:= E_Name
;
1968 Scopes
(Scope
.Last
).Lreq
:= Present
(Block_Name
);
1969 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1970 Scopes
(Scope
.Last
).Labl
:= Block_Name
;
1971 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1973 if No
(Block_Name
) then
1975 Make_Identifier
(Sloc
(Block_Node
), Set_Loop_Block_Name
('B'));
1976 Set_Comes_From_Source
(Created_Name
, False);
1977 Set_Has_Created_Identifier
(Block_Node
, True);
1978 Set_Identifier
(Block_Node
, Created_Name
);
1979 Scopes
(Scope
.Last
).Labl
:= Created_Name
;
1981 Set_Identifier
(Block_Node
, Block_Name
);
1984 Append_Elmt
(Block_Node
, Label_List
);
1986 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
1987 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
1989 Set_Handled_Statement_Sequence
1990 (Block_Node
, P_Handled_Sequence_Of_Statements
);
1991 End_Statements
(Handled_Statement_Sequence
(Block_Node
));
1993 end P_Begin_Statement
;
1995 -------------------------
1996 -- 5.7 Exit Statement --
1997 -------------------------
1999 -- EXIT_STATEMENT ::=
2000 -- exit [loop_NAME] [when CONDITION];
2002 -- The caller has checked that the initial token is EXIT
2004 -- Error recovery: can raise Error_Resync
2006 function P_Exit_Statement
return Node_Id
is
2007 Exit_Node
: Node_Id
;
2009 -- Start of processing for P_Exit_Statement
2012 Exit_Node
:= New_Node
(N_Exit_Statement
, Token_Ptr
);
2015 if Token
= Tok_Identifier
then
2016 Set_Name
(Exit_Node
, P_Qualified_Simple_Name
);
2018 elsif Style_Check
then
2019 -- This EXIT has no name, so check that
2020 -- the innermost loop is unnamed too.
2022 Check_No_Exit_Name
:
2023 for J
in reverse 1 .. Scope
.Last
loop
2024 if Scopes
(J
).Etyp
= E_Loop
then
2025 if Present
(Scopes
(J
).Labl
)
2026 and then Comes_From_Source
(Scopes
(J
).Labl
)
2028 -- Innermost loop in fact had a name, style check fails
2030 Style
.No_Exit_Name
(Scopes
(J
).Labl
);
2033 exit Check_No_Exit_Name
;
2035 end loop Check_No_Exit_Name
;
2038 if Token
= Tok_When
and then not Missing_Semicolon_On_When
then
2040 Set_Condition
(Exit_Node
, P_Condition
);
2042 -- Allow IF instead of WHEN, giving error message
2044 elsif Token
= Tok_If
then
2046 Scan
; -- past IF used in place of WHEN
2047 Set_Condition
(Exit_Node
, P_Expression_No_Right_Paren
);
2052 end P_Exit_Statement
;
2054 -------------------------
2055 -- 5.8 Goto Statement --
2056 -------------------------
2058 -- GOTO_STATEMENT ::= goto label_NAME;
2060 -- The caller has checked that the initial token is GOTO (or TO in the
2061 -- error case where GO and TO were incorrectly separated).
2063 -- Error recovery: can raise Error_Resync
2065 function P_Goto_Statement
return Node_Id
is
2066 Goto_Node
: Node_Id
;
2069 Goto_Node
:= New_Node
(N_Goto_Statement
, Token_Ptr
);
2070 Scan
; -- past GOTO (or TO)
2071 Set_Name
(Goto_Node
, P_Qualified_Simple_Name_Resync
);
2072 Append_Elmt
(Goto_Node
, Goto_List
);
2074 if Token
= Tok_When
then
2075 Error_Msg_GNAT_Extension
("goto when statement", Token_Ptr
);
2078 Mutate_Nkind
(Goto_Node
, N_Goto_When_Statement
);
2079 Set_Condition
(Goto_Node
, P_Expression_No_Right_Paren
);
2084 end P_Goto_Statement
;
2086 ---------------------------
2087 -- Parse_Decls_Begin_End --
2088 ---------------------------
2090 -- This function parses the construct:
2094 -- HANDLED_SEQUENCE_OF_STATEMENTS
2097 -- The caller has built the scope stack entry, and created the node to
2098 -- whose Declarations and Handled_Statement_Sequence fields are to be
2099 -- set. On return these fields are filled in (except in the case of a
2100 -- task body, where the handled statement sequence is optional, and may
2101 -- thus be Empty), and the scan is positioned past the End sequence.
2103 -- If the BEGIN is missing, then the parent node is used to help construct
2104 -- an appropriate missing BEGIN message. Possibilities for the parent are:
2106 -- N_Block_Statement declare block
2107 -- N_Entry_Body entry body
2108 -- N_Package_Body package body (begin part optional)
2109 -- N_Subprogram_Body procedure or function body
2110 -- N_Task_Body task body
2112 -- Note: in the case of a block statement, there is definitely a DECLARE
2113 -- present (because a Begin statement without a DECLARE is handled by the
2114 -- P_Begin_Statement procedure, which does not call Parse_Decls_Begin_End.
2116 -- Error recovery: cannot raise Error_Resync
2118 procedure Parse_Decls_Begin_End
(Parent
: Node_Id
) is
2119 Body_Decl
: Node_Id
;
2121 Parent_Nkind
: Node_Kind
;
2122 Spec_Node
: Node_Id
;
2125 procedure Missing_Begin
(Msg
: String);
2126 -- Called to post a missing begin message. In the normal case this is
2127 -- posted at the start of the current token. A special case arises when
2128 -- P_Declarative_Items has previously found a missing begin, in which
2129 -- case we replace the original error message.
2131 procedure Set_Null_HSS
(Parent
: Node_Id
);
2132 -- Construct an empty handled statement sequence and install in Parent
2133 -- Leaves HSS set to reference the newly constructed statement sequence.
2139 procedure Missing_Begin
(Msg
: String) is
2141 if Missing_Begin_Msg
= No_Error_Msg
then
2144 Change_Error_Text
(Missing_Begin_Msg
, Msg
);
2146 -- Purge any messages issued after than, since a missing begin
2147 -- can cause a lot of havoc, and it is better not to dump these
2148 -- cascaded messages on the user.
2150 Purge_Messages
(Get_Location
(Missing_Begin_Msg
), Prev_Token_Ptr
);
2158 procedure Set_Null_HSS
(Parent
: Node_Id
) is
2163 Make_Null_Statement
(Token_Ptr
);
2164 Set_Comes_From_Source
(Null_Stm
, False);
2167 Make_Handled_Sequence_Of_Statements
(Token_Ptr
,
2168 Statements
=> New_List
(Null_Stm
));
2169 Set_Comes_From_Source
(HSS
, False);
2171 Set_Handled_Statement_Sequence
(Parent
, HSS
);
2174 -- Start of processing for Parse_Decls_Begin_End
2177 Decls
:= P_Declarative_Part
;
2179 if Ada_Version
= Ada_83
then
2180 Check_Later_Vs_Basic_Declarations
(Decls
, During_Parsing
=> True);
2183 -- Here is where we deal with the case of IS used instead of semicolon.
2184 -- Specifically, if the last declaration in the declarative part is a
2185 -- subprogram body still marked as having a bad IS, then this is where
2186 -- we decide that the IS should really have been a semicolon and that
2187 -- the body should have been a declaration. Note that if the bad IS
2188 -- had turned out to be OK (i.e. a decent begin/end was found for it),
2189 -- then the Bad_Is_Detected flag would have been reset by now.
2191 Body_Decl
:= Last
(Decls
);
2193 if Present
(Body_Decl
)
2194 and then Nkind
(Body_Decl
) = N_Subprogram_Body
2195 and then Bad_Is_Detected
(Body_Decl
)
2197 -- OK, we have the case of a bad IS, so we need to fix up the tree.
2198 -- What we have now is a subprogram body with attached declarations
2199 -- and a possible statement sequence.
2201 -- First step is to take the declarations that were part of the bogus
2202 -- subprogram body and append them to the outer declaration chain.
2203 -- In other words we append them past the body (which we will later
2204 -- convert into a declaration).
2206 Append_List
(Declarations
(Body_Decl
), Decls
);
2208 -- Now take the handled statement sequence of the bogus body and
2209 -- set it as the statement sequence for the outer construct. Note
2210 -- that it may be empty (we specially allowed a missing BEGIN for
2211 -- a subprogram body marked as having a bad IS -- see below).
2213 Set_Handled_Statement_Sequence
(Parent
,
2214 Handled_Statement_Sequence
(Body_Decl
));
2216 -- Next step is to convert the old body node to a declaration node
2218 Spec_Node
:= Specification
(Body_Decl
);
2219 Change_Node
(Body_Decl
, N_Subprogram_Declaration
);
2220 Set_Specification
(Body_Decl
, Spec_Node
);
2222 -- Final step is to put the declarations for the parent where
2223 -- they belong, and then fall through the IF to scan out the
2226 Set_Declarations
(Parent
, Decls
);
2228 -- This is the normal case (i.e. any case except the bad IS case)
2229 -- If we have a BEGIN, then scan out the sequence of statements, and
2230 -- also reset the expected column for the END to match the BEGIN.
2233 Set_Declarations
(Parent
, Decls
);
2235 if Token
= Tok_Begin
then
2237 Style
.Check_Indentation
;
2240 Error_Msg_Col
:= Scopes
(Scope
.Last
).Ecol
;
2243 and then Token_Is_At_Start_Of_Line
2244 and then Start_Column
/= Error_Msg_Col
2246 Error_Msg_SC
("(style) BEGIN in wrong column, should be@");
2249 Scopes
(Scope
.Last
).Ecol
:= Start_Column
;
2252 Scopes
(Scope
.Last
).Sloc
:= Token_Ptr
;
2254 Set_Handled_Statement_Sequence
(Parent
,
2255 P_Handled_Sequence_Of_Statements
);
2260 Parent_Nkind
:= Nkind
(Parent
);
2262 -- A special check for the missing IS case. If we have a
2263 -- subprogram body that was marked as having a suspicious
2264 -- IS, and the current token is END, then we simply confirm
2265 -- the suspicion, and do not require a BEGIN to be present
2267 if Parent_Nkind
= N_Subprogram_Body
2268 and then Token
= Tok_End
2269 and then Scopes
(Scope
.Last
).Etyp
= E_Suspicious_Is
2271 Scopes
(Scope
.Last
).Etyp
:= E_Bad_Is
;
2273 -- Otherwise BEGIN is not required for a package body, so we
2274 -- don't mind if it is missing, but we do construct a dummy
2275 -- one (so that we have somewhere to set End_Label).
2277 -- However if we have something other than a BEGIN which
2278 -- looks like it might be statements, then we signal a missing
2279 -- BEGIN for these cases as well. We define "something which
2280 -- looks like it might be statements" as a token other than
2281 -- END, EOF, or a token which starts declarations.
2283 elsif Parent_Nkind
= N_Package_Body
2284 and then (Token
= Tok_End
2285 or else Token
= Tok_EOF
2286 or else Token
in Token_Class_Declk
)
2288 Set_Null_HSS
(Parent
);
2290 -- These are cases in which a BEGIN is required and not present
2293 Set_Null_HSS
(Parent
);
2295 -- Prepare to issue error message
2297 Error_Msg_Sloc
:= Scopes
(Scope
.Last
).Sloc
;
2298 Error_Msg_Node_1
:= Scopes
(Scope
.Last
).Labl
;
2300 -- Now issue appropriate message
2302 if Parent_Nkind
= N_Block_Statement
then
2303 Missing_Begin
("missing BEGIN for DECLARE#!");
2305 elsif Parent_Nkind
= N_Entry_Body
then
2306 Missing_Begin
("missing BEGIN for ENTRY#!");
2308 elsif Parent_Nkind
= N_Subprogram_Body
then
2309 if Nkind
(Specification
(Parent
))
2310 = N_Function_Specification
2312 Missing_Begin
("missing BEGIN for function&#!");
2314 Missing_Begin
("missing BEGIN for procedure&#!");
2317 -- The case for package body arises only when
2318 -- we have possible statement junk present.
2320 elsif Parent_Nkind
= N_Package_Body
then
2321 Missing_Begin
("missing BEGIN for package body&#!");
2324 pragma Assert
(Parent_Nkind
= N_Task_Body
);
2325 Missing_Begin
("missing BEGIN for task body&#!");
2328 -- Here we pick up the statements after the BEGIN that
2329 -- should have been present but was not. We don't insist
2330 -- on statements being present if P_Declarative_Part had
2331 -- already found a missing BEGIN, since it might have
2332 -- swallowed a lone statement into the declarative part.
2334 if Missing_Begin_Msg
/= No_Error_Msg
2335 and then Token
= Tok_End
2339 Set_Handled_Statement_Sequence
(Parent
,
2340 P_Handled_Sequence_Of_Statements
);
2346 -- Here with declarations and handled statement sequence scanned
2348 if Present
(Handled_Statement_Sequence
(Parent
)) then
2349 End_Statements
(Handled_Statement_Sequence
(Parent
));
2354 -- We know that End_Statements removed an entry from the scope stack
2355 -- (because it is required to do so under all circumstances). We can
2356 -- therefore reference the entry it removed one past the stack top.
2357 -- What we are interested in is whether it was a case of a bad IS.
2358 -- We can't call Scopes here.
2360 if Scope
.Table
(Scope
.Last
+ 1).Etyp
= E_Bad_Is
then
2361 Error_Msg
-- CODEFIX
2362 ("|IS should be "";""", Scope
.Table
(Scope
.Last
+ 1).S_Is
);
2363 Set_Bad_Is_Detected
(Parent
, True);
2366 end Parse_Decls_Begin_End
;
2368 -------------------------
2369 -- Set_Loop_Block_Name --
2370 -------------------------
2372 function Set_Loop_Block_Name
(L
: Character) return Name_Id
is
2374 Name_Buffer
(1) := L
;
2375 Name_Buffer
(2) := '_';
2377 Loop_Block_Count
:= Loop_Block_Count
+ 1;
2378 Add_Nat_To_Name_Buffer
(Loop_Block_Count
);
2380 end Set_Loop_Block_Name
;
2386 procedure Then_Scan
is
2390 while Token
= Tok_Then
loop
2391 Error_Msg_SC
-- CODEFIX
2396 if Token
= Tok_And
or else Token
= Tok_Or
then
2397 Error_Msg_SC
("unexpected logical operator");
2398 Scan
; -- past logical operator
2400 if (Prev_Token
= Tok_And
and then Token
= Tok_Then
)
2402 (Prev_Token
= Tok_Or
and then Token
= Tok_Else
)
2407 Discard_Junk_Node
(P_Expression
);
2410 if Token
= Tok_Then
then