aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.3/gcc/ada/par-ch11.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8.3/gcc/ada/par-ch11.adb')
-rw-r--r--gcc-4.8.3/gcc/ada/par-ch11.adb302
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;