gcc/
[official-gcc.git] / gcc / ada / par-ch11.adb
blob61df3ee2512a56e8a9e25969cd1243659d15c5fa
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . C H 1 1 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, 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 ------------------------------------------------------------------------------
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;
32 separate (Par)
33 package body Ch11 is
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
52 -- [exception
53 -- EXCEPTION_HANDLER
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;
60 Seq_Is_Hidden_In_SPARK : Boolean;
61 Hidden_Region_Start : Source_Ptr;
63 begin
64 Handled_Stmt_Seq_Node :=
65 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
67 -- In SPARK, a HIDE directive can be placed at the beginning of a
68 -- package initialization, thus hiding the sequence of statements (and
69 -- possible exception handlers) from SPARK tool-set. No violation of the
70 -- SPARK restriction should be issued on nodes in a hidden part, which
71 -- is obtained by marking such hidden parts.
73 if Token = Tok_SPARK_Hide then
74 Seq_Is_Hidden_In_SPARK := True;
75 Hidden_Region_Start := Token_Ptr;
76 Scan; -- past HIDE directive
77 else
78 Seq_Is_Hidden_In_SPARK := False;
79 end if;
81 Set_Statements
82 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
84 if Token = Tok_Exception then
85 Scan; -- past EXCEPTION
86 Set_Exception_Handlers
87 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
88 end if;
90 if Seq_Is_Hidden_In_SPARK then
91 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
92 end if;
94 return Handled_Stmt_Seq_Node;
95 end P_Handled_Sequence_Of_Statements;
97 -----------------------------
98 -- 11.2 Exception Handler --
99 -----------------------------
101 -- EXCEPTION_HANDLER ::=
102 -- when [CHOICE_PARAMETER_SPECIFICATION :]
103 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
104 -- SEQUENCE_OF_STATEMENTS
106 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
108 -- Error recovery: cannot raise Error_Resync
110 function P_Exception_Handler return Node_Id is
111 Scan_State : Saved_Scan_State;
112 Handler_Node : Node_Id;
113 Choice_Param_Node : Node_Id;
115 begin
116 Exception_Handler_Encountered := True;
117 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
118 Set_Local_Raise_Statements (Handler_Node, No_Elist);
120 if Style_Check then
121 Style.Check_Indentation;
122 end if;
124 T_When;
126 -- Test for possible choice parameter present
128 if Token = Tok_Identifier then
129 Choice_Param_Node := Token_Node;
130 Save_Scan_State (Scan_State); -- at identifier
131 Scan; -- past identifier
133 if Token = Tok_Colon then
134 if Ada_Version = Ada_83 then
135 Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
136 end if;
138 Scan; -- past :
139 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
140 Warn_If_Standard_Redefinition (Choice_Param_Node);
141 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
143 elsif Token = Tok_Others then
144 Error_Msg_AP -- CODEFIX
145 ("missing "":""");
146 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
147 Warn_If_Standard_Redefinition (Choice_Param_Node);
148 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
150 else
151 Restore_Scan_State (Scan_State); -- to identifier
152 end if;
153 end if;
155 -- Loop through exception choices
157 Set_Exception_Choices (Handler_Node, New_List);
159 loop
160 Append (P_Exception_Choice, Exception_Choices (Handler_Node));
161 exit when Token /= Tok_Vertical_Bar;
162 Scan; -- past vertical bar
163 end loop;
165 TF_Arrow;
166 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
167 return Handler_Node;
168 end P_Exception_Handler;
170 ------------------------------------------
171 -- 11.2 Choice Parameter Specification --
172 ------------------------------------------
174 -- Parsed by P_Exception_Handler (11.2)
176 ----------------------------
177 -- 11.2 Exception Choice --
178 ----------------------------
180 -- EXCEPTION_CHOICE ::= exception_NAME | others
182 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
183 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
185 function P_Exception_Choice return Node_Id is
186 begin
188 if Token = Tok_Others then
189 Scan; -- past OTHERS
190 return New_Node (N_Others_Choice, Prev_Token_Ptr);
192 else
193 return P_Name; -- exception name
194 end if;
196 exception
197 when Error_Resync =>
198 Resync_Choice;
199 return Error;
200 end P_Exception_Choice;
202 ----------------------------
203 -- 11.3 Raise Expression --
204 ----------------------------
206 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]]
208 -- The caller has verified that the initial token is RAISE
210 -- Error recovery: can raise Error_Resync
212 function P_Raise_Expression return Node_Id is
213 Raise_Node : Node_Id;
215 begin
216 Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr);
217 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
218 Scan; -- past RAISE
220 Set_Name (Raise_Node, P_Name);
222 if Token = Tok_With then
223 Scan; -- past WITH
224 Set_Expression (Raise_Node, P_Expression);
225 end if;
227 return Raise_Node;
228 end P_Raise_Expression;
230 ---------------------------
231 -- 11.3 Raise Statement --
232 ---------------------------
234 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
236 -- The caller has verified that the initial token is RAISE
238 -- Error recovery: can raise Error_Resync
240 function P_Raise_Statement return Node_Id is
241 Raise_Node : Node_Id;
243 begin
244 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
245 Scan; -- past RAISE
247 if Token /= Tok_Semicolon then
248 Set_Name (Raise_Node, P_Name);
249 end if;
251 if Token = Tok_With then
252 if Ada_Version < Ada_2005 then
253 Error_Msg_SC ("string expression in raise is Ada 2005 extension");
254 Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
255 end if;
257 Scan; -- past WITH
258 Set_Expression (Raise_Node, P_Expression);
259 end if;
261 TF_Semicolon;
262 return Raise_Node;
263 end P_Raise_Statement;
265 ------------------------------
266 -- Parse_Exception_Handlers --
267 ------------------------------
269 -- This routine scans out a list of exception handlers appearing in a
270 -- construct as:
272 -- exception
273 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
275 -- The caller has scanned out the EXCEPTION keyword
277 -- Control returns after scanning the last exception handler, presumably
278 -- at the keyword END, but this is not checked in this routine.
280 -- Error recovery: cannot raise Error_Resync
282 function Parse_Exception_Handlers return List_Id is
283 Handler : Node_Id;
284 Handlers_List : List_Id;
285 Handler_Is_Hidden_In_SPARK : Boolean;
286 Hidden_Region_Start : Source_Ptr;
288 begin
289 -- In SPARK, a HIDE directive can be placed at the beginning of a
290 -- sequence of exception handlers for a subprogram implementation, thus
291 -- hiding the exception handlers from SPARK tool-set. No violation of
292 -- the SPARK restriction should be issued on nodes in a hidden part,
293 -- which is obtained by marking such hidden parts.
295 if Token = Tok_SPARK_Hide then
296 Handler_Is_Hidden_In_SPARK := True;
297 Hidden_Region_Start := Token_Ptr;
298 Scan; -- past HIDE directive
299 else
300 Handler_Is_Hidden_In_SPARK := False;
301 end if;
303 Handlers_List := New_List;
304 P_Pragmas_Opt (Handlers_List);
306 if Token = Tok_End then
307 Error_Msg_SC ("must have at least one exception handler!");
309 else
310 loop
311 Handler := P_Exception_Handler;
312 Append (Handler, Handlers_List);
314 -- Note: no need to check for pragmas here. Although the
315 -- syntax officially allows them in this position, they
316 -- will have been swallowed up as part of the statement
317 -- sequence of the handler we just scanned out.
319 exit when Token /= Tok_When;
320 end loop;
321 end if;
323 if Handler_Is_Hidden_In_SPARK then
324 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
325 end if;
327 return Handlers_List;
328 end Parse_Exception_Handlers;
330 end Ch11;