Subversion Repositories scarts

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             P A R . C H 1 1                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2005, 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 2,  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 COPYING.  If not, write --

-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --

-- Boston, MA 02110-1301, USA.                                              --

--                                                                          --

-- 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 Ch11 is

   --  Local functions, used only in this chapter

   function P_Exception_Handler  return Node_Id;

   function P_Exception_Choice   return Node_Id;

   ---------------------------------

   -- 11.1  Exception Declaration --

   ---------------------------------

   --  Parsed by P_Identifier_Declaration (3.3.1)

   ------------------------------------------

   -- 11.2  Handled Sequence Of Statements --

   ------------------------------------------

   --  HANDLED_SEQUENCE_OF_STATEMENTS ::=

   --      SEQUENCE_OF_STATEMENTS

   --    [exception

   --      EXCEPTION_HANDLER

   --      {EXCEPTION_HANDLER}]

   --  Error_Recovery : Cannot raise Error_Resync

   function P_Handled_Sequence_Of_Statements return Node_Id is

      Handled_Stmt_Seq_Node : Node_Id;

   begin

      Handled_Stmt_Seq_Node :=

        New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);

      Set_Statements

        (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));

      if Token = Tok_Exception then

         Scan; -- past EXCEPTION

         Set_Exception_Handlers

           (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);

      end if;

      return Handled_Stmt_Seq_Node;

   end P_Handled_Sequence_Of_Statements;

   -----------------------------

   -- 11.2  Exception Handler --

   -----------------------------

   --  EXCEPTION_HANDLER ::=

   --    when [CHOICE_PARAMETER_SPECIFICATION :]

   --      EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>

   --        SEQUENCE_OF_STATEMENTS

   --  CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER

   --  Error recovery: cannot raise Error_Resync

   function P_Exception_Handler return Node_Id is

      Scan_State        : Saved_Scan_State;

      Handler_Node      : Node_Id;

      Choice_Param_Node : Node_Id;

   begin

      Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);

      T_When;

      --  Test for possible choice parameter present

      if Token = Tok_Identifier then

         Choice_Param_Node := Token_Node;

         Save_Scan_State (Scan_State); -- at identifier

         Scan; -- past identifier

         if Token = Tok_Colon then

            if Ada_Version = Ada_83 then

               Error_Msg_SP ("(Ada 83) choice parameter not allowed!");

            end if;

            Scan; -- past :

            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);

            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);

         elsif Token = Tok_Others then

            Error_Msg_AP ("missing "":""");

            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);

            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);

         else

            Restore_Scan_State (Scan_State); -- to identifier

         end if;

      end if;

      --  Loop through exception choices

      Set_Exception_Choices (Handler_Node, New_List);

      loop

         Append (P_Exception_Choice, Exception_Choices (Handler_Node));

         exit when Token /= Tok_Vertical_Bar;

         Scan; -- past vertical bar

      end loop;

      TF_Arrow;

      Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));

      return Handler_Node;

   end P_Exception_Handler;

   ------------------------------------------

   -- 11.2  Choice Parameter Specification --

   ------------------------------------------

   --  Parsed by P_Exception_Handler (11.2)

   ----------------------------

   -- 11.2  Exception Choice --

   ----------------------------

   --  EXCEPTION_CHOICE ::= exception_NAME | others

   --  Error recovery: cannot raise Error_Resync. If an error occurs, then the

   --  scan pointer is advanced to the next arrow or vertical bar or semicolon.

   function P_Exception_Choice return Node_Id is

   begin

      if Token = Tok_Others then

         Scan; -- past OTHERS

         return New_Node (N_Others_Choice, Prev_Token_Ptr);

      else

         return P_Name; -- exception name

      end if;

   exception

      when Error_Resync =>

         Resync_Choice;

         return Error;

   end P_Exception_Choice;

   ---------------------------

   -- 11.3  Raise Statement --

   ---------------------------

   --  RAISE_STATEMENT ::= raise [exception_NAME];

   --  The caller has verified that the initial token is RAISE

   --  Error recovery: can raise Error_Resync

   function P_Raise_Statement return Node_Id is

      Raise_Node : Node_Id;

   begin

      Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);

      Scan; -- past RAISE

      if Token /= Tok_Semicolon then

         Set_Name (Raise_Node, P_Name);

      end if;

      if Token = Tok_With then

         if Ada_Version < Ada_05 then

            Error_Msg_SC ("string expression in raise is Ada 2005 extension");

            Error_Msg_SC ("\unit must be compiled with -gnat05 switch");

         end if;

         Scan; -- past WITH

         Set_Expression (Raise_Node, P_Expression);

      end if;

      TF_Semicolon;

      return Raise_Node;

   end P_Raise_Statement;

   ------------------------------

   -- Parse_Exception_Handlers --

   ------------------------------

   --  This routine scans out a list of exception handlers appearing in a

   --  construct as:

   --    exception

   --      EXCEPTION_HANDLER {EXCEPTION_HANDLER}

   --  The caller has scanned out the EXCEPTION keyword

   --  Control returns after scanning the last exception handler, presumably

   --  at the keyword END, but this is not checked in this routine.

   --  Error recovery: cannot raise Error_Resync

   function Parse_Exception_Handlers return List_Id is

      Handler       : Node_Id;

      Handlers_List : List_Id;

   begin

      Handlers_List := New_List;

      P_Pragmas_Opt (Handlers_List);

      if Token = Tok_End then

         Error_Msg_SC ("must have at least one exception handler!");

      else

         loop

            Handler := P_Exception_Handler;

            Append (Handler, Handlers_List);

            --  Note: no need to check for pragmas here. Although the

            --  syntax officially allows them in this position, they

            --  will have been swallowed up as part of the statement

            --  sequence of the handler we just scanned out.

            exit when Token /= Tok_When;

         end loop;

      end if;

      return Handlers_List;

   end Parse_Exception_Handlers;

end Ch11;