* gcc.dg/guality/guality.exp: Skip on AIX.
[official-gcc.git] / gcc / ada / par-ch11.adb
blobf0537f27cd109597ae59802c4e74e8786b7e9b7e
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 if Ada_Version < Ada_2012 then
217 Error_Msg_SC ("raise expression is an Ada 2012 feature");
218 Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
219 end if;
221 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
222 Scan; -- past RAISE
224 Set_Name (Raise_Node, P_Name);
226 if Token = Tok_With then
227 Scan; -- past WITH
228 Set_Expression (Raise_Node, P_Expression);
229 end if;
231 return Raise_Node;
232 end P_Raise_Expression;
234 ---------------------------
235 -- 11.3 Raise Statement --
236 ---------------------------
238 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
240 -- The caller has verified that the initial token is RAISE
242 -- Error recovery: can raise Error_Resync
244 function P_Raise_Statement return Node_Id is
245 Raise_Node : Node_Id;
247 begin
248 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
249 Scan; -- past RAISE
251 if Token /= Tok_Semicolon then
252 Set_Name (Raise_Node, P_Name);
253 end if;
255 if Token = Tok_With then
256 if Ada_Version < Ada_2005 then
257 Error_Msg_SC ("string expression in raise is Ada 2005 extension");
258 Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
259 end if;
261 Scan; -- past WITH
262 Set_Expression (Raise_Node, P_Expression);
263 end if;
265 TF_Semicolon;
266 return Raise_Node;
267 end P_Raise_Statement;
269 ------------------------------
270 -- Parse_Exception_Handlers --
271 ------------------------------
273 -- This routine scans out a list of exception handlers appearing in a
274 -- construct as:
276 -- exception
277 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
279 -- The caller has scanned out the EXCEPTION keyword
281 -- Control returns after scanning the last exception handler, presumably
282 -- at the keyword END, but this is not checked in this routine.
284 -- Error recovery: cannot raise Error_Resync
286 function Parse_Exception_Handlers return List_Id is
287 Handler : Node_Id;
288 Handlers_List : List_Id;
289 Handler_Is_Hidden_In_SPARK : Boolean;
290 Hidden_Region_Start : Source_Ptr;
292 begin
293 -- In SPARK, a HIDE directive can be placed at the beginning of a
294 -- sequence of exception handlers for a subprogram implementation, thus
295 -- hiding the exception handlers from SPARK tool-set. No violation of
296 -- the SPARK restriction should be issued on nodes in a hidden part,
297 -- which is obtained by marking such hidden parts.
299 if Token = Tok_SPARK_Hide then
300 Handler_Is_Hidden_In_SPARK := True;
301 Hidden_Region_Start := Token_Ptr;
302 Scan; -- past HIDE directive
303 else
304 Handler_Is_Hidden_In_SPARK := False;
305 end if;
307 Handlers_List := New_List;
308 P_Pragmas_Opt (Handlers_List);
310 if Token = Tok_End then
311 Error_Msg_SC ("must have at least one exception handler!");
313 else
314 loop
315 Handler := P_Exception_Handler;
316 Append (Handler, Handlers_List);
318 -- Note: no need to check for pragmas here. Although the
319 -- syntax officially allows them in this position, they
320 -- will have been swallowed up as part of the statement
321 -- sequence of the handler we just scanned out.
323 exit when Token /= Tok_When;
324 end loop;
325 end if;
327 if Handler_Is_Hidden_In_SPARK then
328 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
329 end if;
331 return Handlers_List;
332 end Parse_Exception_Handlers;
334 end Ch11;