URL https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [par-ch5.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P A R . C H 5                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
pragma Style_Checks (All_Checks);
--  Turn off subprogram body ordering check. Subprograms are in order by RM
--  section rather than alphabetical.
 
with Sinfo.CN; use Sinfo.CN;
 
separate (Par)
package body Ch5 is
 
   --  Local functions, used only in this chapter
 
   function P_Case_Statement                     return Node_Id;
   function P_Case_Statement_Alternative         return Node_Id;
   function P_Exit_Statement                     return Node_Id;
   function P_Goto_Statement                     return Node_Id;
   function P_If_Statement                       return Node_Id;
   function P_Label                              return Node_Id;
   function P_Null_Statement                     return Node_Id;
 
   function P_Assignment_Statement (LHS : Node_Id)  return Node_Id;
   --  Parse assignment statement. On entry, the caller has scanned the left
   --  hand side (passed in as Lhs), and the colon-equal (or some symbol
   --  taken to be an error equivalent such as equal).
 
   function P_Begin_Statement (Block_Name : Node_Id := Empty) return Node_Id;
   --  Parse begin-end statement. If Block_Name is non-Empty on entry, it is
   --  the N_Identifier node for the label on the block. If Block_Name is
   --  Empty on entry (the default), then the block statement is unlabeled.
 
   function P_Declare_Statement (Block_Name : Node_Id := Empty) return Node_Id;
   --  Parse declare block. If Block_Name is non-Empty on entry, it is
   --  the N_Identifier node for the label on the block. If Block_Name is
   --  Empty on entry (the default), then the block statement is unlabeled.
 
   function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
   --  Parse for statement. If Loop_Name is non-Empty on entry, it is
   --  the N_Identifier node for the label on the loop. If Loop_Name is
   --  Empty on entry (the default), then the for statement is unlabeled.
 
   function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
   --  Parse an iterator specification. The defining identifier has already
   --  been scanned, as it is the common prefix between loop and iterator
   --  specification.
 
   function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
   --  Parse loop statement. If Loop_Name is non-Empty on entry, it is
   --  the N_Identifier node for the label on the loop. If Loop_Name is
   --  Empty on entry (the default), then the loop statement is unlabeled.
 
   function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
   --  Parse while statement. If Loop_Name is non-Empty on entry, it is
   --  the N_Identifier node for the label on the loop. If Loop_Name is
   --  Empty on entry (the default), then the while statement is unlabeled.
 
   function Set_Loop_Block_Name (L : Character) return Name_Id;
   --  Given a letter 'L' for a loop or 'B' for a block, returns a name
   --  of the form L_nn or B_nn where nn is a serial number obtained by
   --  incrementing the variable Loop_Block_Count.
 
   procedure Then_Scan;
   --  Scan past THEN token, testing for illegal junk after it
 
   ---------------------------------
   -- 5.1  Sequence of Statements --
   ---------------------------------
 
   --  SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
   --  Note: the final label is an Ada 2012 addition.
 
   --  STATEMENT ::=
   --    {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
 
   --  SIMPLE_STATEMENT ::=      NULL_STATEMENT
   --  | ASSIGNMENT_STATEMENT  | EXIT_STATEMENT
   --  | GOTO_STATEMENT        | PROCEDURE_CALL_STATEMENT
   --  | RETURN_STATEMENT      | ENTRY_CALL_STATEMENT
   --  | REQUEUE_STATEMENT     | DELAY_STATEMENT
   --  | ABORT_STATEMENT       | RAISE_STATEMENT
   --  | CODE_STATEMENT
 
   --  COMPOUND_STATEMENT ::=
   --    IF_STATEMENT         | CASE_STATEMENT
   --  | LOOP_STATEMENT       | BLOCK_STATEMENT
   --  | ACCEPT_STATEMENT     | SELECT_STATEMENT
 
   --  This procedure scans a sequence of statements. The caller sets SS_Flags
   --  to indicate acceptable termination conditions for the sequence:
 
   --    SS_Flags.Eftm Terminate on ELSIF
   --    SS_Flags.Eltm Terminate on ELSE
   --    SS_Flags.Extm Terminate on EXCEPTION
   --    SS_Flags.Ortm Terminate on OR
   --    SS_Flags.Tatm Terminate on THEN ABORT (Token = ABORT on return)
   --    SS_Flags.Whtm Terminate on WHEN
   --    SS_Flags.Unco Unconditional terminate after scanning one statement
 
   --  In addition, the scan is always terminated by encountering END or the
   --  end of file (EOF) condition. If one of the six above terminators is
   --  encountered with the corresponding SS_Flags flag not set, then the
   --  action taken is as follows:
 
   --    If the keyword occurs to the left of the expected column of the end
   --    for the current sequence (as recorded in the current end context),
   --    then it is assumed to belong to an outer context, and is considered
   --    to terminate the sequence of statements.
 
   --    If the keyword occurs to the right of, or in the expected column of
   --    the end for the current sequence, then an error message is output,
   --    the keyword together with its associated context is skipped, and
   --    the statement scan continues until another terminator is found.
 
   --  Note that the first action means that control can return to the caller
   --  with Token set to a terminator other than one of those specified by the
   --  SS parameter. The caller should treat such a case as equivalent to END.
 
   --  In addition, the flag SS_Flags.Sreq is set to True to indicate that at
   --  least one real statement (other than a pragma) is required in the
   --  statement sequence. During the processing of the sequence, this
   --  flag is manipulated to indicate the current status of the requirement
   --  for a statement. For example, it is turned off by the occurrence of a
   --  statement, and back on by a label (which requires a following statement)
 
   --  Error recovery: cannot raise Error_Resync. If an error occurs during
   --  parsing a statement, then the scan pointer is advanced past the next
   --  semicolon and the parse continues.
 
   function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id is
 
      Statement_Required : Boolean;
      --  This flag indicates if a subsequent statement (other than a pragma)
      --  is required. It is initialized from the Sreq flag, and modified as
      --  statements are scanned (a statement turns it off, and a label turns
      --  it back on again since a statement must follow a label).
      --  Note : this final requirement is lifted in Ada 2012.
 
      Statement_Seen : Boolean;
      --  In Ada 2012, a label can end a sequence of statements, but the
      --  sequence cannot contain only labels. This flag is set whenever a
      --  label is encountered, to enforce this rule at the end of a sequence.
 
      Declaration_Found : Boolean := False;
      --  This flag is set True if a declaration is encountered, so that the
      --  error message about declarations in the statement part is only
      --  given once for a given sequence of statements.
 
      Scan_State_Label : Saved_Scan_State;
      Scan_State       : Saved_Scan_State;
 
      Statement_List : List_Id;
      Block_Label    : Name_Id;
      Id_Node        : Node_Id;
      Name_Node      : Node_Id;
 
      procedure Junk_Declaration;
      --  Procedure called to handle error of declaration encountered in
      --  statement sequence.
 
      procedure Test_Statement_Required;
      --  Flag error if Statement_Required flag set
 
      ----------------------
      -- Junk_Declaration --
      ----------------------
 
      procedure Junk_Declaration is
      begin
         if (not Declaration_Found) or All_Errors_Mode then
            Error_Msg_SC -- CODEFIX
              ("declarations must come before BEGIN");
            Declaration_Found := True;
         end if;
 
         Skip_Declaration (Statement_List);
      end Junk_Declaration;
 
      -----------------------------
      -- Test_Statement_Required --
      -----------------------------
 
      procedure Test_Statement_Required is
         function All_Pragmas return Boolean;
         --  Return True if statement list is all pragmas
 
         -----------------
         -- All_Pragmas --
         -----------------
 
         function All_Pragmas return Boolean is
            S : Node_Id;
         begin
            S := First (Statement_List);
            while Present (S) loop
               if Nkind (S) /= N_Pragma then
                  return False;
               else
                  Next (S);
               end if;
            end loop;
 
            return True;
         end All_Pragmas;
 
      --  Start of processing for Test_Statement_Required
 
      begin
         if Statement_Required then
 
            --  Check no statement required after label in Ada 2012, and that
            --  it is OK to have nothing but pragmas in a statement sequence.
 
            if Ada_Version >= Ada_2012
              and then not Is_Empty_List (Statement_List)
              and then
                ((Nkind (Last (Statement_List)) = N_Label
                   and then Statement_Seen)
                or else All_Pragmas)
            then
               declare
                  Null_Stm : constant Node_Id :=
                               Make_Null_Statement (Token_Ptr);
               begin
                  Set_Comes_From_Source (Null_Stm, False);
                  Append_To (Statement_List, Null_Stm);
               end;
 
            --  If not Ada 2012, or not special case above, give error message
 
            else
               Error_Msg_BC -- CODEFIX
                 ("statement expected");
            end if;
         end if;
      end Test_Statement_Required;
 
   --  Start of processing for P_Sequence_Of_Statements
 
   begin
      Statement_List := New_List;
      Statement_Required := SS_Flags.Sreq;
      Statement_Seen     := False;
 
      loop
         Ignore (Tok_Semicolon);
 
         begin
            if Style_Check then
               Style.Check_Indentation;
            end if;
 
            --  Deal with reserved identifier (in assignment or call)
 
            if Is_Reserved_Identifier then
               Save_Scan_State (Scan_State); -- at possible bad identifier
               Scan; -- and scan past it
 
               --  We have an reserved word which is spelled in identifier
               --  style, so the question is whether it really is intended
               --  to be an identifier.
 
               if
                  --  If followed by a semicolon, then it is an identifier,
                  --  with the exception of the cases tested for below.
 
                  (Token = Tok_Semicolon
                    and then Prev_Token /= Tok_Return
                    and then Prev_Token /= Tok_Null
                    and then Prev_Token /= Tok_Raise
                    and then Prev_Token /= Tok_End
                    and then Prev_Token /= Tok_Exit)
 
                  --  If followed by colon, colon-equal, or dot, then we
                  --  definitely  have an identifier (could not be reserved)
 
                  or else Token = Tok_Colon
                  or else Token = Tok_Colon_Equal
                  or else Token = Tok_Dot
 
                  --  Left paren means we have an identifier except for those
                  --  reserved words that can legitimately be followed by a
                  --  left paren.
 
                  or else
                    (Token = Tok_Left_Paren
                      and then Prev_Token /= Tok_Case
                      and then Prev_Token /= Tok_Delay
                      and then Prev_Token /= Tok_If
                      and then Prev_Token /= Tok_Elsif
                      and then Prev_Token /= Tok_Return
                      and then Prev_Token /= Tok_When
                      and then Prev_Token /= Tok_While
                      and then Prev_Token /= Tok_Separate)
               then
                  --  Here we have an apparent reserved identifier and the
                  --  token past it is appropriate to this usage (and would
                  --  be a definite error if this is not an identifier). What
                  --  we do is to use P_Identifier to fix up the identifier,
                  --  and then fall into the normal processing.
 
                  Restore_Scan_State (Scan_State); -- back to the ID
                  Scan_Reserved_Identifier (Force_Msg => False);
 
                  --  Not a reserved identifier after all (or at least we can't
                  --  be sure that it is), so reset the scan and continue.
 
               else
                  Restore_Scan_State (Scan_State); -- back to the reserved word
               end if;
            end if;
 
            --  Now look to see what kind of statement we have
 
            case Token is
 
               --  Case of end or EOF
 
               when Tok_End | Tok_EOF =>
 
                  --  These tokens always terminate the statement sequence
 
                  Test_Statement_Required;
                  exit;
 
               --  Case of ELSIF
 
               when Tok_Elsif =>
 
                  --  Terminate if Eftm set or if the ELSIF is to the left
                  --  of the expected column of the end for this sequence
 
                  if SS_Flags.Eftm
                     or else Start_Column < Scope.Table (Scope.Last).Ecol
                  then
                     Test_Statement_Required;
                     exit;
 
                  --  Otherwise complain and skip past ELSIF Condition then
 
                  else
                     Error_Msg_SC ("ELSIF not allowed here");
                     Scan; -- past ELSIF
                     Discard_Junk_Node (P_Expression_No_Right_Paren);
                     Then_Scan;
                     Statement_Required := False;
                  end if;
 
               --  Case of ELSE
 
               when Tok_Else =>
 
                  --  Terminate if Eltm set or if the else is to the left
                  --  of the expected column of the end for this sequence
 
                  if SS_Flags.Eltm
                     or else Start_Column < Scope.Table (Scope.Last).Ecol
                  then
                     Test_Statement_Required;
                     exit;
 
                  --  Otherwise complain and skip past else
 
                  else
                     Error_Msg_SC ("ELSE not allowed here");
                     Scan; -- past ELSE
                     Statement_Required := False;
                  end if;
 
               --  Case of exception
 
               when Tok_Exception =>
                  Test_Statement_Required;
 
                  --  If Extm not set and the exception is not to the left of
                  --  the expected column of the end for this sequence, then we
                  --  assume it belongs to the current sequence, even though it
                  --  is not permitted.
 
                  if not SS_Flags.Extm and then
                     Start_Column >= Scope.Table (Scope.Last).Ecol
 
                  then
                     Error_Msg_SC ("exception handler not permitted here");
                     Scan; -- past EXCEPTION
                     Discard_Junk_List (Parse_Exception_Handlers);
                  end if;
 
                  --  Always return, in the case where we scanned out handlers
                  --  that we did not expect, Parse_Exception_Handlers returned
                  --  with Token being either end or EOF, so we are OK.
 
                  exit;
 
               --  Case of OR
 
               when Tok_Or =>
 
                  --  Terminate if Ortm set or if the or is to the left of the
                  --  expected column of the end for this sequence.
 
                  if SS_Flags.Ortm
                     or else Start_Column < Scope.Table (Scope.Last).Ecol
                  then
                     Test_Statement_Required;
                     exit;
 
                  --  Otherwise complain and skip past or
 
                  else
                     Error_Msg_SC ("OR not allowed here");
                     Scan; -- past or
                     Statement_Required := False;
                  end if;
 
               --  Case of THEN (deal also with THEN ABORT)
 
               when Tok_Then =>
                  Save_Scan_State (Scan_State); -- at THEN
                  Scan; -- past THEN
 
                  --  Terminate if THEN ABORT allowed (ATC case)
 
                  exit when SS_Flags.Tatm and then Token = Tok_Abort;
 
                  --  Otherwise we treat THEN as some kind of mess where we did
                  --  not see the associated IF, but we pick up assuming it had
                  --  been there!
 
                  Restore_Scan_State (Scan_State); -- to THEN
                  Append_To (Statement_List, P_If_Statement);
                  Statement_Required := False;
 
               --  Case of WHEN (error because we are not in a case)
 
               when Tok_When | Tok_Others =>
 
                  --  Terminate if Whtm set or if the WHEN is to the left of
                  --  the expected column of the end for this sequence.
 
                  if SS_Flags.Whtm
                     or else Start_Column < Scope.Table (Scope.Last).Ecol
                  then
                     Test_Statement_Required;
                     exit;
 
                  --  Otherwise complain and skip when Choice {| Choice} =>
 
                  else
                     Error_Msg_SC ("WHEN not allowed here");
                     Scan; -- past when
                     Discard_Junk_List (P_Discrete_Choice_List);
                     TF_Arrow;
                     Statement_Required := False;
                  end if;
 
               --  Cases of statements starting with an identifier
 
               when Tok_Identifier =>
                  Check_Bad_Layout;
 
                  --  Save scan pointers and line number in case block label
 
                  Id_Node := Token_Node;
                  Block_Label := Token_Name;
                  Save_Scan_State (Scan_State_Label); -- at possible label
                  Scan; -- past Id
 
                  --  Check for common case of assignment, since it occurs
                  --  frequently, and we want to process it efficiently.
 
                  if Token = Tok_Colon_Equal then
                     Scan; -- past the colon-equal
                     Append_To (Statement_List,
                       P_Assignment_Statement (Id_Node));
                     Statement_Required := False;
 
                  --  Check common case of procedure call, another case that
                  --  we want to speed up as much as possible.
 
                  elsif Token = Tok_Semicolon then
                     Change_Name_To_Procedure_Call_Statement (Id_Node);
                     Append_To (Statement_List, Id_Node);
                     Scan; -- past semicolon
                     Statement_Required := False;
 
                  --  Check for case of "go to" in place of "goto"
 
                  elsif Token = Tok_Identifier
                    and then Block_Label = Name_Go
                    and then Token_Name = Name_To
                  then
                     Error_Msg_SP -- CODEFIX
                       ("goto is one word");
                     Append_To (Statement_List, P_Goto_Statement);
                     Statement_Required := False;
 
                  --  Check common case of = used instead of :=, just so we
                  --  give a better error message for this special misuse.
 
                  elsif Token = Tok_Equal then
                     T_Colon_Equal; -- give := expected message
                     Append_To (Statement_List,
                       P_Assignment_Statement (Id_Node));
                     Statement_Required := False;
 
                  --  Check case of loop label or block label
 
                  elsif Token = Tok_Colon
                    or else (Token in Token_Class_Labeled_Stmt
                              and then not Token_Is_At_Start_Of_Line)
                  then
                     T_Colon; -- past colon (if there, or msg for missing one)
 
                     --  Test for more than one label
 
                     loop
                        exit when Token /= Tok_Identifier;
                        Save_Scan_State (Scan_State); -- at second Id
                        Scan; -- past Id
 
                        if Token = Tok_Colon then
                           Error_Msg_SP
                              ("only one label allowed on block or loop");
                           Scan; -- past colon on extra label
 
                           --  Use the second label as the "real" label
 
                           Scan_State_Label := Scan_State;
 
                           --  We will set Error_name as the Block_Label since
                           --  we really don't know which of the labels might
                           --  be used at the end of the loop or block!
 
                           Block_Label := Error_Name;
 
                        --  If Id with no colon, then backup to point to the
                        --  Id and we will issue the message below when we try
                        --  to scan out the statement as some other form.
 
                        else
                           Restore_Scan_State (Scan_State); -- to second Id
                           exit;
                        end if;
                     end loop;
 
                     --  Loop_Statement (labeled Loop_Statement)
 
                     if Token = Tok_Loop then
                        Append_To (Statement_List,
                          P_Loop_Statement (Id_Node));
 
                     --  While statement (labeled loop statement with WHILE)
 
                     elsif Token = Tok_While then
                        Append_To (Statement_List,
                          P_While_Statement (Id_Node));
 
                     --  Declare statement (labeled block statement with
                     --  DECLARE part)
 
                     elsif Token = Tok_Declare then
                        Append_To (Statement_List,
                          P_Declare_Statement (Id_Node));
 
                     --  Begin statement (labeled block statement with no
                     --  DECLARE part)
 
                     elsif Token = Tok_Begin then
                        Append_To (Statement_List,
                          P_Begin_Statement (Id_Node));
 
                     --  For statement (labeled loop statement with FOR)
 
                     elsif Token = Tok_For then
                        Append_To (Statement_List,
                          P_For_Statement (Id_Node));
 
                     --  Improper statement follows label. If we have an
                     --  expression token, then assume the colon was part
                     --  of a misplaced declaration.
 
                     elsif Token not in Token_Class_Eterm then
                        Restore_Scan_State (Scan_State_Label);
                        Junk_Declaration;
 
                     --  Otherwise complain we have inappropriate statement
 
                     else
                        Error_Msg_AP
                          ("loop or block statement must follow label");
                     end if;
 
                     Statement_Required := False;
 
                  --  Here we have an identifier followed by something
                  --  other than a colon, semicolon or assignment symbol.
                  --  The only valid possibility is a name extension symbol
 
                  elsif Token in Token_Class_Namext then
                     Restore_Scan_State (Scan_State_Label); -- to Id
                     Name_Node := P_Name;
 
                     --  Skip junk right parens in this context
 
                     Ignore (Tok_Right_Paren);
 
                     --  Check context following call
 
                     if Token = Tok_Colon_Equal then
                        Scan; -- past colon equal
                        Append_To (Statement_List,
                          P_Assignment_Statement (Name_Node));
                        Statement_Required := False;
 
                     --  Check common case of = used instead of :=
 
                     elsif Token = Tok_Equal then
                        T_Colon_Equal; -- give := expected message
                        Append_To (Statement_List,
                          P_Assignment_Statement (Name_Node));
                        Statement_Required := False;
 
                     --  Check apostrophe cases
 
                     elsif Token = Tok_Apostrophe then
                        Append_To (Statement_List,
                          P_Code_Statement (Name_Node));
                        Statement_Required := False;
 
                     --  The only other valid item after a name is ; which
                     --  means that the item we just scanned was a call.
 
                     elsif Token = Tok_Semicolon then
                        Change_Name_To_Procedure_Call_Statement (Name_Node);
                        Append_To (Statement_List, Name_Node);
                        Scan; -- past semicolon
                        Statement_Required := False;
 
                     --  A slash following an identifier or a selected
                     --  component in this situation is most likely a period
                     --  (see location of keys on keyboard).
 
                     elsif Token = Tok_Slash
                       and then (Nkind (Name_Node) = N_Identifier
                                   or else
                                 Nkind (Name_Node) = N_Selected_Component)
                     then
                        Error_Msg_SC -- CODEFIX
                          ("""/"" should be "".""");
                        Statement_Required := False;
                        raise Error_Resync;
 
                     --  Else we have a missing semicolon
 
                     else
                        TF_Semicolon;
                        Statement_Required := False;
                     end if;
 
                  --  If junk after identifier, check if identifier is an
                  --  instance of an incorrectly spelled keyword. If so, we
                  --  do nothing. The Bad_Spelling_Of will have reset Token
                  --  to the appropriate keyword, so the next time round the
                  --  loop we will process the modified token. Note that we
                  --  check for ELSIF before ELSE here. That's not accidental.
                  --  We don't want to identify a misspelling of ELSE as
                  --  ELSIF, and in particular we do not want to treat ELSEIF
                  --  as ELSE IF.
 
                  else
                     Restore_Scan_State (Scan_State_Label); -- to identifier
 
                     if Bad_Spelling_Of (Tok_Abort)
                       or else Bad_Spelling_Of (Tok_Accept)
                       or else Bad_Spelling_Of (Tok_Case)
                       or else Bad_Spelling_Of (Tok_Declare)
                       or else Bad_Spelling_Of (Tok_Delay)
                       or else Bad_Spelling_Of (Tok_Elsif)
                       or else Bad_Spelling_Of (Tok_Else)
                       or else Bad_Spelling_Of (Tok_End)
                       or else Bad_Spelling_Of (Tok_Exception)
                       or else Bad_Spelling_Of (Tok_Exit)
                       or else Bad_Spelling_Of (Tok_For)
                       or else Bad_Spelling_Of (Tok_Goto)
                       or else Bad_Spelling_Of (Tok_If)
                       or else Bad_Spelling_Of (Tok_Loop)
                       or else Bad_Spelling_Of (Tok_Or)
                       or else Bad_Spelling_Of (Tok_Pragma)
                       or else Bad_Spelling_Of (Tok_Raise)
                       or else Bad_Spelling_Of (Tok_Requeue)
                       or else Bad_Spelling_Of (Tok_Return)
                       or else Bad_Spelling_Of (Tok_Select)
                       or else Bad_Spelling_Of (Tok_When)
                       or else Bad_Spelling_Of (Tok_While)
                     then
                        null;
 
                     --  If not a bad spelling, then we really have junk
 
                     else
                        Scan; -- past identifier again
 
                        --  If next token is first token on line, then we
                        --  consider that we were missing a semicolon after
                        --  the identifier, and process it as a procedure
                        --  call with no parameters.
 
                        if Token_Is_At_Start_Of_Line then
                           Change_Name_To_Procedure_Call_Statement (Id_Node);
                           Append_To (Statement_List, Id_Node);
                           T_Semicolon; -- to give error message
                           Statement_Required := False;
 
                        --  Otherwise we give a missing := message and
                        --  simply abandon the junk that is there now.
 
                        else
                           T_Colon_Equal; -- give := expected message
                           raise Error_Resync;
                        end if;
 
                     end if;
                  end if;
 
               --  Statement starting with operator symbol. This could be
               --  a call, a name starting an assignment, or a qualified
               --  expression.
 
               when Tok_Operator_Symbol =>
                  Check_Bad_Layout;
                  Name_Node := P_Name;
 
                  --  An attempt at a range attribute or a qualified expression
                  --  must be illegal here (a code statement cannot possibly
                  --  allow qualification by a function name).
 
                  if Token = Tok_Apostrophe then
                     Error_Msg_SC ("apostrophe illegal here");
                     raise Error_Resync;
                  end if;
 
                  --  Scan possible assignment if we have a name
 
                  if Expr_Form = EF_Name
                    and then Token = Tok_Colon_Equal
                  then
                     Scan; -- past colon equal
                     Append_To (Statement_List,
                       P_Assignment_Statement (Name_Node));
                  else
                     Change_Name_To_Procedure_Call_Statement (Name_Node);
                     Append_To (Statement_List, Name_Node);
                  end if;
 
                  TF_Semicolon;
                  Statement_Required := False;
 
               --  Label starting with << which must precede real statement
               --  Note: in Ada 2012, the label may end the sequence.
 
               when Tok_Less_Less =>
                  if Present (Last (Statement_List))
                    and then Nkind (Last (Statement_List)) /= N_Label
                  then
                     Statement_Seen := True;
                  end if;
 
                  Append_To (Statement_List, P_Label);
                  Statement_Required := True;
 
               --  Pragma appearing as a statement in a statement sequence
 
               when Tok_Pragma =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Pragma);
 
               --  Abort_Statement
 
               when Tok_Abort =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Abort_Statement);
                  Statement_Required := False;
 
               --  Accept_Statement
 
               when Tok_Accept =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Accept_Statement);
                  Statement_Required := False;
 
               --  Begin_Statement (Block_Statement with no declare, no label)
 
               when Tok_Begin =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Begin_Statement);
                  Statement_Required := False;
 
               --  Case_Statement
 
               when Tok_Case =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Case_Statement);
                  Statement_Required := False;
 
               --  Block_Statement with DECLARE and no label
 
               when Tok_Declare =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Declare_Statement);
                  Statement_Required := False;
 
               --  Delay_Statement
 
               when Tok_Delay =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Delay_Statement);
                  Statement_Required := False;
 
               --  Exit_Statement
 
               when Tok_Exit =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Exit_Statement);
                  Statement_Required := False;
 
               --  Loop_Statement with FOR and no label
 
               when Tok_For =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_For_Statement);
                  Statement_Required := False;
 
               --  Goto_Statement
 
               when Tok_Goto =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Goto_Statement);
                  Statement_Required := False;
 
               --  If_Statement
 
               when Tok_If =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_If_Statement);
                  Statement_Required := False;
 
               --  Loop_Statement
 
               when Tok_Loop =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Loop_Statement);
                  Statement_Required := False;
 
               --  Null_Statement
 
               when Tok_Null =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Null_Statement);
                  Statement_Required := False;
 
               --  Raise_Statement
 
               when Tok_Raise =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Raise_Statement);
                  Statement_Required := False;
 
               --  Requeue_Statement
 
               when Tok_Requeue =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Requeue_Statement);
                  Statement_Required := False;
 
               --  Return_Statement
 
               when Tok_Return =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Return_Statement);
                  Statement_Required := False;
 
               --  Select_Statement
 
               when Tok_Select =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_Select_Statement);
                  Statement_Required := False;
 
               --  While_Statement (Block_Statement with while and no loop)
 
               when Tok_While =>
                  Check_Bad_Layout;
                  Append_To (Statement_List, P_While_Statement);
                  Statement_Required := False;
 
               --  Anything else is some kind of junk, signal an error message
               --  and then raise Error_Resync, to merge with the normal
               --  handling of a bad statement.
 
               when others =>
 
                  if Token in Token_Class_Declk then
                     Junk_Declaration;
 
                  else
                     Error_Msg_BC -- CODEFIX
                       ("statement expected");
                     raise Error_Resync;
                  end if;
            end case;
 
         --  On error resynchronization, skip past next semicolon, and, since
         --  we are still in the statement loop, look for next statement. We
         --  set Statement_Required False to avoid an unnecessary error message
         --  complaining that no statement was found (i.e. we consider the
         --  junk to satisfy the requirement for a statement being present).
 
         exception
            when Error_Resync =>
               Resync_Past_Semicolon_Or_To_Loop_Or_Then;
               Statement_Required := False;
         end;
 
         exit when SS_Flags.Unco;
 
      end loop;
 
      return Statement_List;
 
   end P_Sequence_Of_Statements;
 
   --------------------
   -- 5.1  Statement --
   --------------------
 
   ---------------------------
   -- 5.1  Simple Statement --
   ---------------------------
 
   --  Parsed by P_Sequence_Of_Statements (5.1)
 
   -----------------------------
   -- 5.1  Compound Statement --
   -----------------------------
 
   --  Parsed by P_Sequence_Of_Statements (5.1)
 
   -------------------------
   -- 5.1  Null Statement --
   -------------------------
 
   --  NULL_STATEMENT ::= null;
 
   --  The caller has already checked that the current token is null
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_Null_Statement return Node_Id is
      Null_Stmt_Node : Node_Id;
 
   begin
      Null_Stmt_Node := New_Node (N_Null_Statement, Token_Ptr);
      Scan; -- past NULL
      TF_Semicolon;
      return Null_Stmt_Node;
   end P_Null_Statement;
 
   ----------------
   -- 5.1  Label --
   ----------------
 
   --  LABEL ::= <<label_STATEMENT_IDENTIFIER>>
 
   --  STATEMENT_IDENTIFIER ::= DIRECT_NAME
 
   --  The IDENTIFIER of a STATEMENT_IDENTIFIER shall be an identifier
   --  (not an OPERATOR_SYMBOL)
 
   --  The caller has already checked that the current token is <<
 
   --  Error recovery: can raise Error_Resync
 
   function P_Label return Node_Id is
      Label_Node : Node_Id;
 
   begin
      Label_Node := New_Node (N_Label, Token_Ptr);
      Scan; -- past <<
      Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
      T_Greater_Greater;
      Append_Elmt (Label_Node, Label_List);
      return Label_Node;
   end P_Label;
 
   -------------------------------
   -- 5.1  Statement Identifier --
   -------------------------------
 
   --  Statement label is parsed by P_Label (5.1)
 
   --  Loop label is parsed by P_Loop_Statement (5.5), P_For_Statement (5.5)
   --   or P_While_Statement (5.5)
 
   --  Block label is parsed by P_Begin_Statement (5.6) or
   --   P_Declare_Statement (5.6)
 
   -------------------------------
   -- 5.2  Assignment Statement --
   -------------------------------
 
   --  ASSIGNMENT_STATEMENT ::=
   --    variable_NAME := EXPRESSION;
 
   --  Error recovery: can raise Error_Resync
 
   function P_Assignment_Statement (LHS : Node_Id) return Node_Id is
      Assign_Node : Node_Id;
 
   begin
      Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr);
      Set_Name (Assign_Node, LHS);
      Set_Expression (Assign_Node, P_Expression_No_Right_Paren);
      TF_Semicolon;
      return Assign_Node;
   end P_Assignment_Statement;
 
   -----------------------
   -- 5.3  If Statement --
   -----------------------
 
   --  IF_STATEMENT ::=
   --    if CONDITION then
   --      SEQUENCE_OF_STATEMENTS
   --    {elsif CONDITION then
   --      SEQUENCE_OF_STATEMENTS}
   --    [else
   --      SEQUENCE_OF_STATEMENTS]
   --    end if;
 
   --  The caller has checked that the initial token is IF (or in the error
   --  case of a mysterious THEN, the initial token may simply be THEN, in
   --  which case, no condition (or IF) was scanned).
 
   --  Error recovery: can raise Error_Resync
 
   function P_If_Statement return Node_Id is
      If_Node    : Node_Id;
      Elsif_Node : Node_Id;
      Loc        : Source_Ptr;
 
      procedure Add_Elsif_Part;
      --  An internal procedure used to scan out a single ELSIF part. On entry
      --  the ELSIF (or an ELSE which has been determined should be ELSIF) is
      --  scanned out and is in Prev_Token.
 
      procedure Check_If_Column;
      --  An internal procedure used to check that THEN, ELSE, or ELSIF
      --  appear in the right place if column checking is enabled (i.e. if
      --  they are the first token on the line, then they must appear in
      --  the same column as the opening IF).
 
      procedure Check_Then_Column;
      --  This procedure carries out the style checks for a THEN token
      --  Note that the caller has set Loc to the Source_Ptr value for
      --  the previous IF or ELSIF token. These checks apply only to a
      --  THEN at the start of a line.
 
      function Else_Should_Be_Elsif return Boolean;
      --  An internal routine used to do a special error recovery check when
      --  an ELSE is encountered. It determines if the ELSE should be treated
      --  as an ELSIF. A positive decision (TRUE returned, is made if the ELSE
      --  is followed by a sequence of tokens, starting on the same line as
      --  the ELSE, which are not expression terminators, followed by a THEN.
      --  On entry, the ELSE has been scanned out.
 
      procedure Add_Elsif_Part is
      begin
         if No (Elsif_Parts (If_Node)) then
            Set_Elsif_Parts (If_Node, New_List);
         end if;
 
         Elsif_Node := New_Node (N_Elsif_Part, Prev_Token_Ptr);
         Loc := Prev_Token_Ptr;
         Set_Condition (Elsif_Node, P_Condition);
         Check_Then_Column;
         Then_Scan;
         Set_Then_Statements
           (Elsif_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
         Append (Elsif_Node, Elsif_Parts (If_Node));
      end Add_Elsif_Part;
 
      procedure Check_If_Column is
      begin
         if RM_Column_Check and then Token_Is_At_Start_Of_Line
           and then Start_Column /= Scope.Table (Scope.Last).Ecol
         then
            Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
            Error_Msg_SC ("(style) this token should be@");
         end if;
      end Check_If_Column;
 
      procedure Check_Then_Column is
      begin
         if Token_Is_At_Start_Of_Line and then Token = Tok_Then then
            Check_If_Column;
 
            if Style_Check then
               Style.Check_Then (Loc);
            end if;
         end if;
      end Check_Then_Column;
 
      function Else_Should_Be_Elsif return Boolean is
         Scan_State : Saved_Scan_State;
 
      begin
         if Token_Is_At_Start_Of_Line then
            return False;
 
         else
            Save_Scan_State (Scan_State);
 
            loop
               if Token in Token_Class_Eterm then
                  Restore_Scan_State (Scan_State);
                  return False;
               else
                  Scan; -- past non-expression terminating token
 
                  if Token = Tok_Then then
                     Restore_Scan_State (Scan_State);
                     return True;
                  end if;
               end if;
            end loop;
         end if;
      end Else_Should_Be_Elsif;
 
   --  Start of processing for P_If_Statement
 
   begin
      If_Node := New_Node (N_If_Statement, Token_Ptr);
 
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Etyp := E_If;
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scope.Table (Scope.Last).Labl := Error;
      Scope.Table (Scope.Last).Node := If_Node;
 
      if Token = Tok_If then
         Loc := Token_Ptr;
         Scan; -- past IF
         Set_Condition (If_Node, P_Condition);
 
         --  Deal with misuse of IF expression => used instead
         --  of WHEN expression =>
 
         if Token = Tok_Arrow then
            Error_Msg_SC -- CODEFIX
              ("THEN expected");
            Scan; -- past the arrow
            Pop_Scope_Stack; -- remove unneeded entry
            raise Error_Resync;
         end if;
 
         Check_Then_Column;
 
      else
         Error_Msg_SC ("no IF for this THEN");
         Set_Condition (If_Node, Error);
      end if;
 
      Then_Scan;
 
      Set_Then_Statements
        (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
 
      --  This loop scans out else and elsif parts
 
      loop
         if Token = Tok_Elsif then
            Check_If_Column;
 
            if Present (Else_Statements (If_Node)) then
               Error_Msg_SP ("ELSIF cannot appear after ELSE");
            end if;
 
            Scan; -- past ELSIF
            Add_Elsif_Part;
 
         elsif Token = Tok_Else then
            Check_If_Column;
            Scan; -- past ELSE
 
            if Else_Should_Be_Elsif then
               Error_Msg_SP -- CODEFIX
                 ("ELSE should be ELSIF");
               Add_Elsif_Part;
 
            else
               --  Here we have an else that really is an else
 
               if Present (Else_Statements (If_Node)) then
                  Error_Msg_SP ("only one ELSE part allowed");
                  Append_List
                    (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq),
                     Else_Statements (If_Node));
               else
                  Set_Else_Statements
                    (If_Node, P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq));
               end if;
            end if;
 
         --  If anything other than ELSE or ELSIF, exit the loop. The token
         --  had better be END (and in fact it had better be END IF), but
         --  we will let End_Statements take care of checking that.
 
         else
            exit;
         end if;
      end loop;
 
      End_Statements;
      return If_Node;
 
   end P_If_Statement;
 
   --------------------
   -- 5.3  Condition --
   --------------------
 
   --  CONDITION ::= boolean_EXPRESSION
 
   function P_Condition return Node_Id is
      Cond : Node_Id;
 
   begin
      Cond := P_Expression_No_Right_Paren;
 
      --  It is never possible for := to follow a condition, so if we get
      --  a := we assume it is a mistyped equality. Note that we do not try
      --  to reconstruct the tree correctly in this case, but we do at least
      --  give an accurate error message.
 
      if Token = Tok_Colon_Equal then
         while Token = Tok_Colon_Equal loop
            Error_Msg_SC -- CODEFIX
              (""":="" should be ""=""");
            Scan; -- past junk :=
            Discard_Junk_Node (P_Expression_No_Right_Paren);
         end loop;
 
         return Cond;
 
      --  Otherwise check for redundant parens
 
      else
         if Style_Check
           and then Paren_Count (Cond) > 0
         then
            Style.Check_Xtra_Parens (First_Sloc (Cond));
         end if;
 
         --  And return the result
 
         return Cond;
      end if;
   end P_Condition;
 
   -------------------------
   -- 5.4  Case Statement --
   -------------------------
 
   --  CASE_STATEMENT ::=
   --    case EXPRESSION is
   --      CASE_STATEMENT_ALTERNATIVE
   --      {CASE_STATEMENT_ALTERNATIVE}
   --    end case;
 
   --  The caller has checked that the first token is CASE
 
   --  Can raise Error_Resync
 
   function P_Case_Statement return Node_Id is
      Case_Node         : Node_Id;
      Alternatives_List : List_Id;
      First_When_Loc    : Source_Ptr;
 
   begin
      Case_Node := New_Node (N_Case_Statement, Token_Ptr);
 
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Etyp := E_Case;
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scope.Table (Scope.Last).Labl := Error;
      Scope.Table (Scope.Last).Node := Case_Node;
 
      Scan; -- past CASE
      Set_Expression (Case_Node, P_Expression_No_Right_Paren);
      TF_Is;
 
      --  Prepare to parse case statement alternatives
 
      Alternatives_List := New_List;
      P_Pragmas_Opt (Alternatives_List);
      First_When_Loc := Token_Ptr;
 
      --  Loop through case statement alternatives
 
      loop
         --  If we have a WHEN or OTHERS, then that's fine keep going. Note
         --  that it is a semantic check to ensure the proper use of OTHERS
 
         if Token = Tok_When or else Token = Tok_Others then
            Append (P_Case_Statement_Alternative, Alternatives_List);
 
         --  If we have an END, then probably we are at the end of the case
         --  but we only exit if Check_End thinks the END was reasonable.
 
         elsif Token = Tok_End then
            exit when Check_End;
 
         --  Here if token is other than WHEN, OTHERS or END. We definitely
         --  have an error, but the question is whether or not to get out of
         --  the case statement. We don't want to get out early, or we will
         --  get a slew of junk error messages for subsequent when tokens.
 
         --  If the token is not at the start of the line, or if it is indented
         --  with respect to the current case statement, then the best guess is
         --  that we are still supposed to be inside the case statement. We
         --  complain about the missing WHEN, and discard the junk statements.
 
         elsif not Token_Is_At_Start_Of_Line
           or else Start_Column > Scope.Table (Scope.Last).Ecol
         then
            Error_Msg_BC ("WHEN (case statement alternative) expected");
 
            --  Here is a possibility for infinite looping if we don't make
            --  progress. So try to process statements, otherwise exit
 
            declare
               Error_Ptr : constant Source_Ptr := Scan_Ptr;
            begin
               Discard_Junk_List (P_Sequence_Of_Statements (SS_Whtm));
               exit when Scan_Ptr = Error_Ptr and then Check_End;
            end;
 
         --  Here we have a junk token at the start of the line and it is
         --  not indented. If Check_End thinks there is a missing END, then
         --  we will get out of the case, otherwise we keep going.
 
         else
            exit when Check_End;
         end if;
      end loop;
 
      --  Make sure we have at least one alternative
 
      if No (First_Non_Pragma (Alternatives_List)) then
         Error_Msg
            ("WHEN expected, must have at least one alternative in case",
             First_When_Loc);
         return Error;
 
      else
         Set_Alternatives (Case_Node, Alternatives_List);
         return Case_Node;
      end if;
   end P_Case_Statement;
 
   -------------------------------------
   -- 5.4  Case Statement Alternative --
   -------------------------------------
 
   --  CASE_STATEMENT_ALTERNATIVE ::=
   --    when DISCRETE_CHOICE_LIST =>
   --      SEQUENCE_OF_STATEMENTS
 
   --  The caller has checked that the initial token is WHEN or OTHERS
   --  Error recovery: can raise Error_Resync
 
   function P_Case_Statement_Alternative return Node_Id is
      Case_Alt_Node : Node_Id;
 
   begin
      if Style_Check then
         Style.Check_Indentation;
      end if;
 
      Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr);
      T_When; -- past WHEN (or give error in OTHERS case)
      Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
      TF_Arrow;
      Set_Statements (Case_Alt_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
      return Case_Alt_Node;
   end P_Case_Statement_Alternative;
 
   -------------------------
   -- 5.5  Loop Statement --
   -------------------------
 
   --  LOOP_STATEMENT ::=
   --    [LOOP_STATEMENT_IDENTIFIER:]
   --      [ITERATION_SCHEME] loop
   --        SEQUENCE_OF_STATEMENTS
   --      end loop [loop_IDENTIFIER];
 
   --  ITERATION_SCHEME ::=
   --    while CONDITION
   --  | for LOOP_PARAMETER_SPECIFICATION
 
   --  The parsing of loop statements is handled by one of three functions
   --  P_Loop_Statement, P_For_Statement or P_While_Statement depending
   --  on the initial keyword in the construct (excluding the identifier)
 
   --  P_Loop_Statement
 
   --  This function parses the case where no iteration scheme is present
 
   --  The caller has checked that the initial token is LOOP. The parameter
   --  is the node identifiers for the loop label if any (or is set to Empty
   --  if there is no loop label).
 
   --  Error recovery : cannot raise Error_Resync
 
   function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
      Loop_Node    : Node_Id;
      Created_Name : Node_Id;
 
   begin
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Labl := Loop_Name;
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scope.Table (Scope.Last).Etyp := E_Loop;
 
      Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
      TF_Loop;
 
      if No (Loop_Name) then
         Created_Name :=
           Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
         Set_Comes_From_Source (Created_Name, False);
         Set_Has_Created_Identifier (Loop_Node, True);
         Set_Identifier (Loop_Node, Created_Name);
         Scope.Table (Scope.Last).Labl := Created_Name;
      else
         Set_Identifier (Loop_Node, Loop_Name);
      end if;
 
      Append_Elmt (Loop_Node, Label_List);
      Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
      End_Statements (Loop_Node);
      return Loop_Node;
   end P_Loop_Statement;
 
   --  P_For_Statement
 
   --  This function parses a loop statement with a FOR iteration scheme
 
   --  The caller has checked that the initial token is FOR. The parameter
   --  is the node identifier for the block label if any (or is set to Empty
   --  if there is no block label).
 
   --  Note: the caller fills in the Identifier field if a label was present
 
   --  Error recovery: can raise Error_Resync
 
   function P_For_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
      Loop_Node        : Node_Id;
      Iter_Scheme_Node : Node_Id;
      Loop_For_Flag    : Boolean;
      Created_Name     : Node_Id;
      Spec             : Node_Id;
 
   begin
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Labl := Loop_Name;
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scope.Table (Scope.Last).Etyp := E_Loop;
 
      Loop_For_Flag := (Prev_Token = Tok_Loop);
      Scan; -- past FOR
      Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
      Spec := P_Loop_Parameter_Specification;
 
      if Nkind (Spec) = N_Loop_Parameter_Specification then
         Set_Loop_Parameter_Specification (Iter_Scheme_Node, Spec);
      else
         Set_Iterator_Specification (Iter_Scheme_Node, Spec);
      end if;
 
      --  The following is a special test so that a miswritten for loop such
      --  as "loop for I in 1..10;" is handled nicely, without making an extra
      --  entry in the scope stack. We don't bother to actually fix up the
      --  tree in this case since it's not worth the effort. Instead we just
      --  eat up the loop junk, leaving the entry for what now looks like an
      --  unmodified loop intact.
 
      if Loop_For_Flag and then Token = Tok_Semicolon then
         Error_Msg_SC ("LOOP belongs here, not before FOR");
         Pop_Scope_Stack;
         return Error;
 
      --  Normal case
 
      else
         Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
 
         if No (Loop_Name) then
            Created_Name :=
              Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
            Set_Comes_From_Source (Created_Name, False);
            Set_Has_Created_Identifier (Loop_Node, True);
            Set_Identifier (Loop_Node, Created_Name);
            Scope.Table (Scope.Last).Labl := Created_Name;
         else
            Set_Identifier (Loop_Node, Loop_Name);
         end if;
 
         TF_Loop;
         Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
         End_Statements (Loop_Node);
         Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
         Append_Elmt (Loop_Node, Label_List);
         return Loop_Node;
      end if;
   end P_For_Statement;
 
   --  P_While_Statement
 
   --  This procedure scans a loop statement with a WHILE iteration scheme
 
   --  The caller has checked that the initial token is WHILE. The parameter
   --  is the node identifier for the block label if any (or is set to Empty
   --  if there is no block label).
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_While_Statement (Loop_Name : Node_Id := Empty) return Node_Id is
      Loop_Node        : Node_Id;
      Iter_Scheme_Node : Node_Id;
      Loop_While_Flag  : Boolean;
      Created_Name     : Node_Id;
 
   begin
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Labl := Loop_Name;
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scope.Table (Scope.Last).Etyp := E_Loop;
 
      Loop_While_Flag := (Prev_Token = Tok_Loop);
      Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
      Scan; -- past WHILE
      Set_Condition (Iter_Scheme_Node, P_Condition);
 
      --  The following is a special test so that a miswritten for loop such
      --  as "loop while I > 10;" is handled nicely, without making an extra
      --  entry in the scope stack. We don't bother to actually fix up the
      --  tree in this case since it's not worth the effort. Instead we just
      --  eat up the loop junk, leaving the entry for what now looks like an
      --  unmodified loop intact.
 
      if Loop_While_Flag and then Token = Tok_Semicolon then
         Error_Msg_SC ("LOOP belongs here, not before WHILE");
         Pop_Scope_Stack;
         return Error;
 
      --  Normal case
 
      else
         Loop_Node := New_Node (N_Loop_Statement, Token_Ptr);
         TF_Loop;
 
         if No (Loop_Name) then
            Created_Name :=
              Make_Identifier (Sloc (Loop_Node), Set_Loop_Block_Name ('L'));
            Set_Comes_From_Source (Created_Name, False);
            Set_Has_Created_Identifier (Loop_Node, True);
            Set_Identifier (Loop_Node, Created_Name);
            Scope.Table (Scope.Last).Labl := Created_Name;
         else
            Set_Identifier (Loop_Node, Loop_Name);
         end if;
 
         Set_Statements (Loop_Node, P_Sequence_Of_Statements (SS_Sreq));
         End_Statements (Loop_Node);
         Set_Iteration_Scheme (Loop_Node, Iter_Scheme_Node);
         Append_Elmt (Loop_Node, Label_List);
         return Loop_Node;
      end if;
   end P_While_Statement;
 
   ---------------------------------------
   -- 5.5  Loop Parameter Specification --
   ---------------------------------------
 
   --  LOOP_PARAMETER_SPECIFICATION ::=
   --    DEFINING_IDENTIFIER in [reverse] DISCRETE_SUBTYPE_DEFINITION
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_Loop_Parameter_Specification return Node_Id is
      Loop_Param_Specification_Node : Node_Id;
 
      ID_Node    : Node_Id;
      Scan_State : Saved_Scan_State;
 
   begin
 
      Save_Scan_State (Scan_State);
      ID_Node := P_Defining_Identifier (C_In);
 
      --  If the next token is OF, it indicates an Ada 2012 iterator. If the
      --  next token is a colon, this is also an Ada 2012 iterator, including
      --  a subtype indication for the loop parameter. Otherwise we parse the
      --  construct as a loop parameter specification. Note that the form
      --  "for A in B" is ambiguous, and must be resolved semantically: if B
      --  is a discrete subtype this is a loop specification, but if it is an
      --  expression it is an iterator specification. Ambiguity is resolved
      --  during analysis of the loop parameter specification.
 
      if Token = Tok_Of or else Token = Tok_Colon then
         if Ada_Version < Ada_2012 then
            Error_Msg_SC ("iterator is an Ada 2012 feature");
         end if;
 
         return P_Iterator_Specification (ID_Node);
      end if;
 
      --  The span of the Loop_Parameter_Specification starts at the
      --  defining identifier.
 
      Loop_Param_Specification_Node :=
        New_Node (N_Loop_Parameter_Specification, Sloc (ID_Node));
      Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
 
      if Token = Tok_Left_Paren then
         Error_Msg_SC ("subscripted loop parameter not allowed");
         Restore_Scan_State (Scan_State);
         Discard_Junk_Node (P_Name);
 
      elsif Token = Tok_Dot then
         Error_Msg_SC ("selected loop parameter not allowed");
         Restore_Scan_State (Scan_State);
         Discard_Junk_Node (P_Name);
      end if;
 
      T_In;
 
      if Token = Tok_Reverse then
         Scan; -- past REVERSE
         Set_Reverse_Present (Loop_Param_Specification_Node, True);
      end if;
 
      Set_Discrete_Subtype_Definition
        (Loop_Param_Specification_Node, P_Discrete_Subtype_Definition);
      return Loop_Param_Specification_Node;
 
   exception
      when Error_Resync =>
         return Error;
   end P_Loop_Parameter_Specification;
 
   ----------------------------------
   -- 5.5.1 Iterator_Specification --
   ----------------------------------
 
   function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id is
      Node1 : Node_Id;
 
   begin
      Node1 :=  New_Node (N_Iterator_Specification, Sloc (Def_Id));
      Set_Defining_Identifier (Node1, Def_Id);
 
      if Token = Tok_Colon then
         Scan;  --  past :
         Set_Subtype_Indication (Node1, P_Subtype_Indication);
      end if;
 
      if Token = Tok_Of then
         Set_Of_Present (Node1);
         Scan;  --  past OF
 
      elsif Token = Tok_In then
         Scan;  --  past IN
 
      else
         return Error;
      end if;
 
      if Token = Tok_Reverse then
         Scan; -- past REVERSE
         Set_Reverse_Present (Node1, True);
      end if;
 
      Set_Name (Node1, P_Name);
      return Node1;
   end P_Iterator_Specification;
 
   --------------------------
   -- 5.6  Block Statement --
   --------------------------
 
   --  BLOCK_STATEMENT ::=
   --    [block_STATEMENT_IDENTIFIER:]
   --      [declare
   --        DECLARATIVE_PART]
   --      begin
   --        HANDLED_SEQUENCE_OF_STATEMENTS
   --      end [block_IDENTIFIER];
 
   --  The parsing of block statements is handled by one of the two functions
   --  P_Declare_Statement or P_Begin_Statement depending on whether or not
   --  a declare section is present
 
   --  P_Declare_Statement
 
   --  This function parses a block statement with DECLARE present
 
   --  The caller has checked that the initial token is DECLARE
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_Declare_Statement
     (Block_Name : Node_Id := Empty)
      return       Node_Id
   is
      Block_Node   : Node_Id;
      Created_Name : Node_Id;
 
   begin
      Block_Node := New_Node (N_Block_Statement, Token_Ptr);
 
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Etyp := E_Name;
      Scope.Table (Scope.Last).Lreq := Present (Block_Name);
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Labl := Block_Name;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
 
      Scan; -- past DECLARE
 
      if No (Block_Name) then
         Created_Name :=
           Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
         Set_Comes_From_Source (Created_Name, False);
         Set_Has_Created_Identifier (Block_Node, True);
         Set_Identifier (Block_Node, Created_Name);
         Scope.Table (Scope.Last).Labl := Created_Name;
      else
         Set_Identifier (Block_Node, Block_Name);
      end if;
 
      Append_Elmt (Block_Node, Label_List);
      Parse_Decls_Begin_End (Block_Node);
      return Block_Node;
   end P_Declare_Statement;
 
   --  P_Begin_Statement
 
   --  This function parses a block statement with no DECLARE present
 
   --  The caller has checked that the initial token is BEGIN
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_Begin_Statement
     (Block_Name : Node_Id := Empty)
      return       Node_Id
   is
      Block_Node   : Node_Id;
      Created_Name : Node_Id;
 
   begin
      Block_Node := New_Node (N_Block_Statement, Token_Ptr);
 
      Push_Scope_Stack;
      Scope.Table (Scope.Last).Etyp := E_Name;
      Scope.Table (Scope.Last).Lreq := Present (Block_Name);
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Labl := Block_Name;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
 
      if No (Block_Name) then
         Created_Name :=
           Make_Identifier (Sloc (Block_Node), Set_Loop_Block_Name ('B'));
         Set_Comes_From_Source (Created_Name, False);
         Set_Has_Created_Identifier (Block_Node, True);
         Set_Identifier (Block_Node, Created_Name);
         Scope.Table (Scope.Last).Labl := Created_Name;
      else
         Set_Identifier (Block_Node, Block_Name);
      end if;
 
      Append_Elmt (Block_Node, Label_List);
 
      Scope.Table (Scope.Last).Ecol := Start_Column;
      Scope.Table (Scope.Last).Sloc := Token_Ptr;
      Scan; -- past BEGIN
      Set_Handled_Statement_Sequence
        (Block_Node, P_Handled_Sequence_Of_Statements);
      End_Statements (Handled_Statement_Sequence (Block_Node));
      return Block_Node;
   end P_Begin_Statement;
 
   -------------------------
   -- 5.7  Exit Statement --
   -------------------------
 
   --  EXIT_STATEMENT ::=
   --    exit [loop_NAME] [when CONDITION];
 
   --  The caller has checked that the initial token is EXIT
 
   --  Error recovery: can raise Error_Resync
 
   function P_Exit_Statement return Node_Id is
      Exit_Node : Node_Id;
 
      function Missing_Semicolon_On_Exit return Boolean;
      --  This function deals with the following specialized situation
      --
      --    when 'x' =>
      --       exit [identifier]
      --    when 'y' =>
      --
      --  This looks like a messed up EXIT WHEN, when in fact the problem
      --  is a missing semicolon. It is called with Token pointing to the
      --  WHEN token, and returns True if a semicolon is missing before
      --  the WHEN as in the above example.
 
      -------------------------------
      -- Missing_Semicolon_On_Exit --
      -------------------------------
 
      function Missing_Semicolon_On_Exit return Boolean is
         State : Saved_Scan_State;
 
      begin
         if not Token_Is_At_Start_Of_Line then
            return False;
 
         elsif Scope.Table (Scope.Last).Etyp /= E_Case then
            return False;
 
         else
            Save_Scan_State (State);
            Scan; -- past WHEN
            Scan; -- past token after WHEN
 
            if Token = Tok_Arrow then
               Restore_Scan_State (State);
               return True;
            else
               Restore_Scan_State (State);
               return False;
            end if;
         end if;
      end Missing_Semicolon_On_Exit;
 
   --  Start of processing for P_Exit_Statement
 
   begin
      Exit_Node := New_Node (N_Exit_Statement, Token_Ptr);
      Scan; -- past EXIT
 
      if Token = Tok_Identifier then
         Set_Name (Exit_Node, P_Qualified_Simple_Name);
 
      elsif Style_Check then
         --  This EXIT has no name, so check that
         --  the innermost loop is unnamed too.
 
         Check_No_Exit_Name :
         for J in reverse 1 .. Scope.Last loop
            if Scope.Table (J).Etyp = E_Loop then
               if Present (Scope.Table (J).Labl)
                 and then Comes_From_Source (Scope.Table (J).Labl)
               then
                  --  Innermost loop in fact had a name, style check fails
 
                  Style.No_Exit_Name (Scope.Table (J).Labl);
               end if;
 
               exit Check_No_Exit_Name;
            end if;
         end loop Check_No_Exit_Name;
      end if;
 
      if Token = Tok_When and then not Missing_Semicolon_On_Exit then
         Scan; -- past WHEN
         Set_Condition (Exit_Node, P_Condition);
 
      --  Allow IF instead of WHEN, giving error message
 
      elsif Token = Tok_If then
         T_When;
         Scan; -- past IF used in place of WHEN
         Set_Condition (Exit_Node, P_Expression_No_Right_Paren);
      end if;
 
      TF_Semicolon;
      return Exit_Node;
   end P_Exit_Statement;
 
   -------------------------
   -- 5.8  Goto Statement --
   -------------------------
 
   --  GOTO_STATEMENT ::= goto label_NAME;
 
   --  The caller has checked that the initial token is GOTO  (or TO in the
   --  error case where GO and TO were incorrectly separated).
 
   --  Error recovery: can raise Error_Resync
 
   function P_Goto_Statement return Node_Id is
      Goto_Node : Node_Id;
 
   begin
      Goto_Node := New_Node (N_Goto_Statement, Token_Ptr);
      Scan; -- past GOTO (or TO)
      Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync);
      Append_Elmt (Goto_Node, Goto_List);
      No_Constraint;
      TF_Semicolon;
      return Goto_Node;
   end P_Goto_Statement;
 
   ---------------------------
   -- Parse_Decls_Begin_End --
   ---------------------------
 
   --  This function parses the construct:
 
   --      DECLARATIVE_PART
   --    begin
   --      HANDLED_SEQUENCE_OF_STATEMENTS
   --    end [NAME];
 
   --  The caller has built the scope stack entry, and created the node to
   --  whose Declarations and Handled_Statement_Sequence fields are to be
   --  set. On return these fields are filled in (except in the case of a
   --  task body, where the handled statement sequence is optional, and may
   --  thus be Empty), and the scan is positioned past the End sequence.
 
   --  If the BEGIN is missing, then the parent node is used to help construct
   --  an appropriate missing BEGIN message. Possibilities for the parent are:
 
   --    N_Block_Statement     declare block
   --    N_Entry_Body          entry body
   --    N_Package_Body        package body (begin part optional)
   --    N_Subprogram_Body     procedure or function body
   --    N_Task_Body           task body
 
   --  Note: in the case of a block statement, there is definitely a DECLARE
   --  present (because a Begin statement without a DECLARE is handled by the
   --  P_Begin_Statement procedure, which does not call Parse_Decls_Begin_End.
 
   --  Error recovery: cannot raise Error_Resync
 
   procedure Parse_Decls_Begin_End (Parent : Node_Id) is
      Body_Decl    : Node_Id;
      Decls        : List_Id;
      Parent_Nkind : Node_Kind;
      Spec_Node    : Node_Id;
      HSS          : Node_Id;
 
      procedure Missing_Begin (Msg : String);
      --  Called to post a missing begin message. In the normal case this is
      --  posted at the start of the current token. A special case arises when
      --  P_Declarative_Items has previously found a missing begin, in which
      --  case we replace the original error message.
 
      procedure Set_Null_HSS (Parent : Node_Id);
      --  Construct an empty handled statement sequence and install in Parent
      --  Leaves HSS set to reference the newly constructed statement sequence.
 
      -------------------
      -- Missing_Begin --
      -------------------
 
      procedure Missing_Begin (Msg : String) is
      begin
         if Missing_Begin_Msg = No_Error_Msg then
            Error_Msg_BC (Msg);
         else
            Change_Error_Text (Missing_Begin_Msg, Msg);
 
            --  Purge any messages issued after than, since a missing begin
            --  can cause a lot of havoc, and it is better not to dump these
            --  cascaded messages on the user.
 
            Purge_Messages (Get_Location (Missing_Begin_Msg), Prev_Token_Ptr);
         end if;
      end Missing_Begin;
 
      ------------------
      -- Set_Null_HSS --
      ------------------
 
      procedure Set_Null_HSS (Parent : Node_Id) is
         Null_Stm : Node_Id;
 
      begin
         Null_Stm :=
           Make_Null_Statement (Token_Ptr);
         Set_Comes_From_Source (Null_Stm, False);
 
         HSS :=
           Make_Handled_Sequence_Of_Statements (Token_Ptr,
             Statements => New_List (Null_Stm));
         Set_Comes_From_Source (HSS, False);
 
         Set_Handled_Statement_Sequence (Parent, HSS);
      end Set_Null_HSS;
 
   --  Start of processing for Parse_Decls_Begin_End
 
   begin
      Decls := P_Declarative_Part;
 
      if Ada_Version = Ada_83 then
         Check_Later_Vs_Basic_Declarations (Decls, During_Parsing => True);
      end if;
 
      --  Here is where we deal with the case of IS used instead of semicolon.
      --  Specifically, if the last declaration in the declarative part is a
      --  subprogram body still marked as having a bad IS, then this is where
      --  we decide that the IS should really have been a semicolon and that
      --  the body should have been a declaration. Note that if the bad IS
      --  had turned out to be OK (i.e. a decent begin/end was found for it),
      --  then the Bad_Is_Detected flag would have been reset by now.
 
      Body_Decl := Last (Decls);
 
      if Present (Body_Decl)
        and then Nkind (Body_Decl) = N_Subprogram_Body
        and then Bad_Is_Detected (Body_Decl)
      then
         --  OK, we have the case of a bad IS, so we need to fix up the tree.
         --  What we have now is a subprogram body with attached declarations
         --  and a possible statement sequence.
 
         --  First step is to take the declarations that were part of the bogus
         --  subprogram body and append them to the outer declaration chain.
         --  In other words we append them past the body (which we will later
         --  convert into a declaration).
 
         Append_List (Declarations (Body_Decl), Decls);
 
         --  Now take the handled statement sequence of the bogus body and
         --  set it as the statement sequence for the outer construct. Note
         --  that it may be empty (we specially allowed a missing BEGIN for
         --  a subprogram body marked as having a bad IS -- see below).
 
         Set_Handled_Statement_Sequence (Parent,
           Handled_Statement_Sequence (Body_Decl));
 
         --  Next step is to convert the old body node to a declaration node
 
         Spec_Node := Specification (Body_Decl);
         Change_Node (Body_Decl, N_Subprogram_Declaration);
         Set_Specification (Body_Decl, Spec_Node);
 
         --  Final step is to put the declarations for the parent where
         --  they belong, and then fall through the IF to scan out the
         --  END statements.
 
         Set_Declarations (Parent, Decls);
 
      --  This is the normal case (i.e. any case except the bad IS case)
      --  If we have a BEGIN, then scan out the sequence of statements, and
      --  also reset the expected column for the END to match the BEGIN.
 
      else
         Set_Declarations (Parent, Decls);
 
         if Token = Tok_Begin then
            if Style_Check then
               Style.Check_Indentation;
            end if;
 
            Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
 
            if RM_Column_Check
              and then Token_Is_At_Start_Of_Line
              and then Start_Column /= Error_Msg_Col
            then
               Error_Msg_SC ("(style) BEGIN in wrong column, should be@");
 
            else
               Scope.Table (Scope.Last).Ecol := Start_Column;
            end if;
 
            Scope.Table (Scope.Last).Sloc := Token_Ptr;
            Scan; -- past BEGIN
            Set_Handled_Statement_Sequence (Parent,
              P_Handled_Sequence_Of_Statements);
 
         --  No BEGIN present
 
         else
            Parent_Nkind := Nkind (Parent);
 
            --  A special check for the missing IS case. If we have a
            --  subprogram body that was marked as having a suspicious
            --  IS, and the current token is END, then we simply confirm
            --  the suspicion, and do not require a BEGIN to be present
 
            if Parent_Nkind = N_Subprogram_Body
              and then Token  = Tok_End
              and then Scope.Table (Scope.Last).Etyp = E_Suspicious_Is
            then
               Scope.Table (Scope.Last).Etyp := E_Bad_Is;
 
            --  Otherwise BEGIN is not required for a package body, so we
            --  don't mind if it is missing, but we do construct a dummy
            --  one (so that we have somewhere to set End_Label).
 
            --  However if we have something other than a BEGIN which
            --  looks like it might be statements, then we signal a missing
            --  BEGIN for these cases as well. We define "something which
            --  looks like it might be statements" as a token other than
            --  END, EOF, or a token which starts declarations.
 
            elsif Parent_Nkind = N_Package_Body
              and then (Token = Tok_End
                          or else Token = Tok_EOF
                          or else Token in Token_Class_Declk)
            then
               Set_Null_HSS (Parent);
 
            --  These are cases in which a BEGIN is required and not present
 
            else
               Set_Null_HSS (Parent);
 
               --  Prepare to issue error message
 
               Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
               Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
 
               --  Now issue appropriate message
 
               if Parent_Nkind = N_Block_Statement then
                  Missing_Begin ("missing BEGIN for DECLARE#!");
 
               elsif Parent_Nkind = N_Entry_Body then
                  Missing_Begin ("missing BEGIN for ENTRY#!");
 
               elsif Parent_Nkind = N_Subprogram_Body then
                  if Nkind (Specification (Parent))
                               = N_Function_Specification
                  then
                     Missing_Begin ("missing BEGIN for function&#!");
                  else
                     Missing_Begin ("missing BEGIN for procedure&#!");
                  end if;
 
               --  The case for package body arises only when
               --  we have possible statement junk present.
 
               elsif Parent_Nkind = N_Package_Body then
                  Missing_Begin ("missing BEGIN for package body&#!");
 
               else
                  pragma Assert (Parent_Nkind = N_Task_Body);
                  Missing_Begin ("missing BEGIN for task body&#!");
               end if;
 
               --  Here we pick up the statements after the BEGIN that
               --  should have been present but was not. We don't insist
               --  on statements being present if P_Declarative_Part had
               --  already found a missing BEGIN, since it might have
               --  swallowed a lone statement into the declarative part.
 
               if Missing_Begin_Msg /= No_Error_Msg
                 and then Token = Tok_End
               then
                  null;
               else
                  Set_Handled_Statement_Sequence (Parent,
                    P_Handled_Sequence_Of_Statements);
               end if;
            end if;
         end if;
      end if;
 
      --  Here with declarations and handled statement sequence scanned
 
      if Present (Handled_Statement_Sequence (Parent)) then
         End_Statements (Handled_Statement_Sequence (Parent));
      else
         End_Statements;
      end if;
 
      --  We know that End_Statements removed an entry from the scope stack
      --  (because it is required to do so under all circumstances). We can
      --  therefore reference the entry it removed one past the stack top.
      --  What we are interested in is whether it was a case of a bad IS.
 
      if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
         Error_Msg -- CODEFIX
           ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
         Set_Bad_Is_Detected (Parent, True);
      end if;
 
   end Parse_Decls_Begin_End;
 
   -------------------------
   -- Set_Loop_Block_Name --
   -------------------------
 
   function Set_Loop_Block_Name (L : Character) return Name_Id is
   begin
      Name_Buffer (1) := L;
      Name_Buffer (2) := '_';
      Name_Len := 2;
      Loop_Block_Count := Loop_Block_Count + 1;
      Add_Nat_To_Name_Buffer (Loop_Block_Count);
      return Name_Find;
   end Set_Loop_Block_Name;
 
   ---------------
   -- Then_Scan --
   ---------------
 
   procedure Then_Scan is
   begin
      TF_Then;
 
      while Token = Tok_Then loop
         Error_Msg_SC -- CODEFIX
           ("redundant THEN");
         TF_Then;
      end loop;
 
      if Token = Tok_And or else Token = Tok_Or then
         Error_Msg_SC ("unexpected logical operator");
         Scan; -- past logical operator
 
         if (Prev_Token = Tok_And and then Token = Tok_Then)
              or else
            (Prev_Token = Tok_Or  and then Token = Tok_Else)
         then
            Scan;
         end if;
 
         Discard_Junk_Node (P_Expression);
      end if;
 
      if Token = Tok_Then then
         Scan;
      end if;
   end Then_Scan;
 
end Ch5;
Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [par-ch5.adb] - Blame information for rev 706

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- P A R . C H 5 --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
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. --`
20			`-- --`
21			`-- GNAT was originally developed by the GNAT team at New York University. --`
22			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
23			`-- --`
24			`------------------------------------------------------------------------------`
25
26			`pragma Style_Checks (All_Checks);`
27			`-- Turn off subprogram body ordering check. Subprograms are in order by RM`
28			`-- section rather than alphabetical.`
29
30			`with Sinfo.CN; use Sinfo.CN;`
31
32			`separate (Par)`
33			`package body Ch5 is`
34
35			`-- Local functions, used only in this chapter`
36
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;`