1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2012, 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
;
60 Seq_Is_Hidden_In_SPARK
: Boolean;
61 Hidden_Region_Start
: Source_Ptr
;
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
78 Seq_Is_Hidden_In_SPARK
:= False;
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
);
90 if Seq_Is_Hidden_In_SPARK
then
91 Set_Hidden_Part_In_SPARK
(Hidden_Region_Start
, Token_Ptr
);
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
;
116 Exception_Handler_Encountered
:= True;
117 Handler_Node
:= New_Node
(N_Exception_Handler
, Token_Ptr
);
118 Set_Local_Raise_Statements
(Handler_Node
, No_Elist
);
121 Style
.Check_Indentation
;
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!");
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
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
);
151 Restore_Scan_State
(Scan_State
); -- to identifier
155 -- Loop through exception choices
157 Set_Exception_Choices
(Handler_Node
, New_List
);
160 Append
(P_Exception_Choice
, Exception_Choices
(Handler_Node
));
161 exit when Token
/= Tok_Vertical_Bar
;
162 Scan
; -- past vertical bar
166 Set_Statements
(Handler_Node
, P_Sequence_Of_Statements
(SS_Sreq_Whtm
));
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
188 if Token
= Tok_Others
then
190 return New_Node
(N_Others_Choice
, Prev_Token_Ptr
);
193 return P_Name
; -- exception name
200 end P_Exception_Choice
;
202 ---------------------------
203 -- 11.3 Raise Statement --
204 ---------------------------
206 -- RAISE_STATEMENT ::= raise [exception_NAME];
208 -- The caller has verified that the initial token is RAISE
210 -- Error recovery: can raise Error_Resync
212 function P_Raise_Statement
return Node_Id
is
213 Raise_Node
: Node_Id
;
216 Raise_Node
:= New_Node
(N_Raise_Statement
, Token_Ptr
);
219 if Token
/= Tok_Semicolon
then
220 Set_Name
(Raise_Node
, P_Name
);
223 if Token
= Tok_With
then
224 if Ada_Version
< Ada_2005
then
225 Error_Msg_SC
("string expression in raise is Ada 2005 extension");
226 Error_Msg_SC
("\unit must be compiled with -gnat05 switch");
230 Set_Expression
(Raise_Node
, P_Expression
);
235 end P_Raise_Statement
;
237 ------------------------------
238 -- Parse_Exception_Handlers --
239 ------------------------------
241 -- This routine scans out a list of exception handlers appearing in a
245 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
247 -- The caller has scanned out the EXCEPTION keyword
249 -- Control returns after scanning the last exception handler, presumably
250 -- at the keyword END, but this is not checked in this routine.
252 -- Error recovery: cannot raise Error_Resync
254 function Parse_Exception_Handlers
return List_Id
is
256 Handlers_List
: List_Id
;
257 Handler_Is_Hidden_In_SPARK
: Boolean;
258 Hidden_Region_Start
: Source_Ptr
;
261 -- In SPARK, a HIDE directive can be placed at the beginning of a
262 -- sequence of exception handlers for a subprogram implementation, thus
263 -- hiding the exception handlers from SPARK tool-set. No violation of
264 -- the SPARK restriction should be issued on nodes in a hidden part,
265 -- which is obtained by marking such hidden parts.
267 if Token
= Tok_SPARK_Hide
then
268 Handler_Is_Hidden_In_SPARK
:= True;
269 Hidden_Region_Start
:= Token_Ptr
;
270 Scan
; -- past HIDE directive
272 Handler_Is_Hidden_In_SPARK
:= False;
275 Handlers_List
:= New_List
;
276 P_Pragmas_Opt
(Handlers_List
);
278 if Token
= Tok_End
then
279 Error_Msg_SC
("must have at least one exception handler!");
283 Handler
:= P_Exception_Handler
;
284 Append
(Handler
, Handlers_List
);
286 -- Note: no need to check for pragmas here. Although the
287 -- syntax officially allows them in this position, they
288 -- will have been swallowed up as part of the statement
289 -- sequence of the handler we just scanned out.
291 exit when Token
/= Tok_When
;
295 if Handler_Is_Hidden_In_SPARK
then
296 Set_Hidden_Part_In_SPARK
(Hidden_Region_Start
, Token_Ptr
);
299 return Handlers_List
;
300 end Parse_Exception_Handlers
;