diff options
Diffstat (limited to 'gcc-4.8.3/gcc/ada/par-ch11.adb')
| -rw-r--r-- | gcc-4.8.3/gcc/ada/par-ch11.adb | 302 |
1 files changed, 302 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/par-ch11.adb b/gcc-4.8.3/gcc/ada/par-ch11.adb new file mode 100644 index 000000000..c25532569 --- /dev/null +++ b/gcc-4.8.3/gcc/ada/par-ch11.adb @@ -0,0 +1,302 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P A R . C H 1 1 -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2012, 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 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; + Seq_Is_Hidden_In_SPARK : Boolean; + Hidden_Region_Start : Source_Ptr; + + begin + Handled_Stmt_Seq_Node := + New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr); + + -- In SPARK, a HIDE directive can be placed at the beginning of a + -- package initialization, thus hiding the sequence of statements (and + -- possible exception handlers) from SPARK tool-set. No violation of the + -- SPARK restriction should be issued on nodes in a hidden part, which + -- is obtained by marking such hidden parts. + + if Token = Tok_SPARK_Hide then + Seq_Is_Hidden_In_SPARK := True; + Hidden_Region_Start := Token_Ptr; + Scan; -- past HIDE directive + else + Seq_Is_Hidden_In_SPARK := False; + end if; + + 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; + + if Seq_Is_Hidden_In_SPARK then + Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); + 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 + Exception_Handler_Encountered := True; + Handler_Node := New_Node (N_Exception_Handler, Token_Ptr); + Set_Local_Raise_Statements (Handler_Node, No_Elist); + + if Style_Check then + Style.Check_Indentation; + end if; + + 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); + Warn_If_Standard_Redefinition (Choice_Param_Node); + Set_Choice_Parameter (Handler_Node, Choice_Param_Node); + + elsif Token = Tok_Others then + Error_Msg_AP -- CODEFIX + ("missing "":"""); + Change_Identifier_To_Defining_Identifier (Choice_Param_Node); + Warn_If_Standard_Redefinition (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_2005 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; + Handler_Is_Hidden_In_SPARK : Boolean; + Hidden_Region_Start : Source_Ptr; + + begin + -- In SPARK, a HIDE directive can be placed at the beginning of a + -- sequence of exception handlers for a subprogram implementation, thus + -- hiding the exception handlers from SPARK tool-set. No violation of + -- the SPARK restriction should be issued on nodes in a hidden part, + -- which is obtained by marking such hidden parts. + + if Token = Tok_SPARK_Hide then + Handler_Is_Hidden_In_SPARK := True; + Hidden_Region_Start := Token_Ptr; + Scan; -- past HIDE directive + else + Handler_Is_Hidden_In_SPARK := False; + end if; + + 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; + + if Handler_Is_Hidden_In_SPARK then + Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); + end if; + + return Handlers_List; + end Parse_Exception_Handlers; + +end Ch11; |