1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 with Sinfo.CN; use Sinfo.CN;
35 -- Local functions, used only in this chapter
37 function P_Exception_Handler return Node_Id;
38 function P_Exception_Choice return Node_Id;
40 ---------------------------------
41 -- 11.1 Exception Declaration --
42 ---------------------------------
44 -- Parsed by P_Identifier_Declaration (3.3.1)
46 ------------------------------------------
47 -- 11.2 Handled Sequence Of Statements --
48 ------------------------------------------
50 -- HANDLED_SEQUENCE_OF_STATEMENTS ::=
51 -- SEQUENCE_OF_STATEMENTS
54 -- {EXCEPTION_HANDLER}]
56 -- Error_Recovery : Cannot raise Error_Resync
58 function P_Handled_Sequence_Of_Statements return Node_Id is
59 Handled_Stmt_Seq_Node : Node_Id;
61 Handled_Stmt_Seq_Node :=
62 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
64 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
66 if Token = Tok_Exception then
67 Scan; -- past EXCEPTION
68 Set_Exception_Handlers
69 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
72 return Handled_Stmt_Seq_Node;
73 end P_Handled_Sequence_Of_Statements;
75 -----------------------------
76 -- 11.2 Exception Handler --
77 -----------------------------
79 -- EXCEPTION_HANDLER ::=
80 -- when [CHOICE_PARAMETER_SPECIFICATION :]
81 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
82 -- SEQUENCE_OF_STATEMENTS
84 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
86 -- Error recovery: cannot raise Error_Resync
88 function P_Exception_Handler return Node_Id is
89 Scan_State : Saved_Scan_State;
90 Handler_Node : Node_Id;
91 Choice_Param_Node : Node_Id;
94 Exception_Handler_Encountered := True;
95 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
96 Set_Local_Raise_Statements (Handler_Node, No_Elist);
99 Style.Check_Indentation;
104 -- Test for possible choice parameter present
106 if Token = Tok_Identifier then
107 Choice_Param_Node := Token_Node;
108 Save_Scan_State (Scan_State); -- at identifier
109 Scan; -- past identifier
111 if Token = Tok_Colon then
112 if Ada_Version = Ada_83 then
113 Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
117 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
118 Warn_If_Standard_Redefinition (Choice_Param_Node);
119 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
121 elsif Token = Tok_Others then
122 Error_Msg_AP -- CODEFIX
124 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
125 Warn_If_Standard_Redefinition (Choice_Param_Node);
126 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
129 Restore_Scan_State (Scan_State); -- to identifier
133 -- Loop through exception choices
135 Set_Exception_Choices (Handler_Node, New_List);
138 Append (P_Exception_Choice, Exception_Choices (Handler_Node));
139 exit when Token /= Tok_Vertical_Bar;
140 Scan; -- past vertical bar
144 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
146 end P_Exception_Handler;
148 ------------------------------------------
149 -- 11.2 Choice Parameter Specification --
150 ------------------------------------------
152 -- Parsed by P_Exception_Handler (11.2)
154 ----------------------------
155 -- 11.2 Exception Choice --
156 ----------------------------
158 -- EXCEPTION_CHOICE ::= exception_NAME | others
160 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
161 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
163 function P_Exception_Choice return Node_Id is
166 if Token = Tok_Others then
168 return New_Node (N_Others_Choice, Prev_Token_Ptr);
171 return P_Name; -- exception name
178 end P_Exception_Choice;
180 ----------------------------
181 -- 11.3 Raise Expression --
182 ----------------------------
184 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]]
186 -- The caller has verified that the initial token is RAISE
188 -- Error recovery: can raise Error_Resync
190 function P_Raise_Expression return Node_Id is
191 Raise_Node : Node_Id;
194 Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr);
195 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
198 Set_Name (Raise_Node, P_Name);
200 if Token = Tok_With then
202 Set_Expression (Raise_Node, P_Expression);
206 end P_Raise_Expression;
208 ---------------------------
209 -- 11.3 Raise Statement --
210 ---------------------------
212 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
214 -- The caller has verified that the initial token is RAISE
216 -- Error recovery: can raise Error_Resync
218 function P_Raise_Statement return Node_Id is
219 Raise_Node : Node_Id;
222 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
225 if Token /= Tok_Semicolon then
226 Set_Name (Raise_Node, P_Name);
229 if Token = Tok_With then
230 Error_Msg_Ada_2005_Extension ("string expression in raise");
233 Set_Expression (Raise_Node, P_Expression);
236 if Token = Tok_When then
237 Error_Msg_GNAT_Extension ("raise when statement");
239 Mutate_Nkind (Raise_Node, N_Raise_When_Statement);
241 if Token = Tok_When and then not Missing_Semicolon_On_When then
243 Set_Condition (Raise_Node, P_Expression_No_Right_Paren);
245 -- Allow IF instead of WHEN, giving error message
247 elsif Token = Tok_If then
249 Scan; -- past IF used in place of WHEN
250 Set_Condition (Raise_Node, P_Expression_No_Right_Paren);
256 end P_Raise_Statement;
258 ------------------------------
259 -- Parse_Exception_Handlers --
260 ------------------------------
262 -- This routine scans out a list of exception handlers appearing in a
266 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
268 -- The caller has scanned out the EXCEPTION keyword
270 -- Control returns after scanning the last exception handler, presumably
271 -- at the keyword END, but this is not checked in this routine.
273 -- Error recovery: cannot raise Error_Resync
275 function Parse_Exception_Handlers return List_Id is
277 Handlers_List : List_Id;
280 Handlers_List := New_List;
281 P_Pragmas_Opt (Handlers_List);
283 if Token = Tok_End then
284 Error_Msg_SC ("must have at least one exception handler!");
288 Handler := P_Exception_Handler;
289 Append (Handler, Handlers_List);
291 -- Note: no need to check for pragmas here. Although the
292 -- syntax officially allows them in this position, they
293 -- will have been swallowed up as part of the statement
294 -- sequence of the handler we just scanned out.
296 exit when Token /= Tok_When;
300 return Handlers_List;
301 end Parse_Exception_Handlers;