1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, 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
,
65 P_Sequence_Of_Statements
(SS_Extm_Sreq
, Handled
=> True));
67 if Token
= Tok_Exception
then
68 Scan
; -- past EXCEPTION
69 Set_Exception_Handlers
70 (Handled_Stmt_Seq_Node
, Parse_Exception_Handlers
);
73 return Handled_Stmt_Seq_Node
;
74 end P_Handled_Sequence_Of_Statements
;
76 -----------------------------
77 -- 11.2 Exception Handler --
78 -----------------------------
80 -- EXCEPTION_HANDLER ::=
81 -- when [CHOICE_PARAMETER_SPECIFICATION :]
82 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
83 -- SEQUENCE_OF_STATEMENTS
85 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
87 -- Error recovery: cannot raise Error_Resync
89 function P_Exception_Handler
return Node_Id
is
90 Scan_State
: Saved_Scan_State
;
91 Handler_Node
: Node_Id
;
92 Choice_Param_Node
: Node_Id
;
95 Exception_Handler_Encountered
:= True;
96 Handler_Node
:= New_Node
(N_Exception_Handler
, Token_Ptr
);
97 Set_Local_Raise_Statements
(Handler_Node
, No_Elist
);
100 Style
.Check_Indentation
;
105 -- Test for possible choice parameter present
107 if Token
= Tok_Identifier
then
108 Choice_Param_Node
:= Token_Node
;
109 Save_Scan_State
(Scan_State
); -- at identifier
110 Scan
; -- past identifier
112 if Token
= Tok_Colon
then
113 if Ada_Version
= Ada_83
then
114 Error_Msg_SP
("(Ada 83) choice parameter not allowed!");
118 Change_Identifier_To_Defining_Identifier
(Choice_Param_Node
);
119 Warn_If_Standard_Redefinition
(Choice_Param_Node
);
120 Set_Choice_Parameter
(Handler_Node
, Choice_Param_Node
);
122 elsif Token
= Tok_Others
then
123 Error_Msg_AP
-- CODEFIX
125 Change_Identifier_To_Defining_Identifier
(Choice_Param_Node
);
126 Warn_If_Standard_Redefinition
(Choice_Param_Node
);
127 Set_Choice_Parameter
(Handler_Node
, Choice_Param_Node
);
130 Restore_Scan_State
(Scan_State
); -- to identifier
134 -- Loop through exception choices
136 Set_Exception_Choices
(Handler_Node
, New_List
);
139 Append
(P_Exception_Choice
, Exception_Choices
(Handler_Node
));
140 exit when Token
/= Tok_Vertical_Bar
;
141 Scan
; -- past vertical bar
145 Set_Statements
(Handler_Node
, P_Sequence_Of_Statements
(SS_Sreq_Whtm
));
147 end P_Exception_Handler
;
149 ------------------------------------------
150 -- 11.2 Choice Parameter Specification --
151 ------------------------------------------
153 -- Parsed by P_Exception_Handler (11.2)
155 ----------------------------
156 -- 11.2 Exception Choice --
157 ----------------------------
159 -- EXCEPTION_CHOICE ::= exception_NAME | others
161 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
162 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
164 function P_Exception_Choice
return Node_Id
is
167 if Token
= Tok_Others
then
169 return New_Node
(N_Others_Choice
, Prev_Token_Ptr
);
172 return P_Name
; -- exception name
179 end P_Exception_Choice
;
181 ----------------------------
182 -- 11.3 Raise Expression --
183 ----------------------------
185 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]]
187 -- The caller has verified that the initial token is RAISE
189 -- Error recovery: can raise Error_Resync
191 function P_Raise_Expression
return Node_Id
is
192 Raise_Node
: Node_Id
;
195 Error_Msg_Ada_2012_Feature
("raise expression", Token_Ptr
);
196 Raise_Node
:= New_Node
(N_Raise_Expression
, Token_Ptr
);
199 Set_Name
(Raise_Node
, P_Name
);
201 if Token
= Tok_With
then
203 Set_Expression
(Raise_Node
, P_Expression
);
207 end P_Raise_Expression
;
209 ---------------------------
210 -- 11.3 Raise Statement --
211 ---------------------------
213 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
215 -- The caller has verified that the initial token is RAISE
217 -- Error recovery: can raise Error_Resync
219 function P_Raise_Statement
return Node_Id
is
220 Raise_Node
: Node_Id
;
223 Raise_Node
:= New_Node
(N_Raise_Statement
, Token_Ptr
);
226 if Token
/= Tok_Semicolon
then
227 Set_Name
(Raise_Node
, P_Name
);
230 if Token
= Tok_With
then
231 Error_Msg_Ada_2005_Extension
("string expression in raise");
234 Set_Expression
(Raise_Node
, P_Expression
);
237 if Token
= Tok_When
then
238 Error_Msg_GNAT_Extension
("raise when statement", Token_Ptr
);
240 Mutate_Nkind
(Raise_Node
, N_Raise_When_Statement
);
242 if Token
= Tok_When
and then not Missing_Semicolon_On_When
then
244 Set_Condition
(Raise_Node
, P_Expression_No_Right_Paren
);
246 -- Allow IF instead of WHEN, giving error message
248 elsif Token
= Tok_If
then
250 Scan
; -- past IF used in place of WHEN
251 Set_Condition
(Raise_Node
, P_Expression_No_Right_Paren
);
257 end P_Raise_Statement
;
259 ------------------------------
260 -- Parse_Exception_Handlers --
261 ------------------------------
263 -- This routine scans out a list of exception handlers appearing in a
267 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
269 -- The caller has scanned out the EXCEPTION keyword
271 -- Control returns after scanning the last exception handler, presumably
272 -- at the keyword END, but this is not checked in this routine.
274 -- Error recovery: cannot raise Error_Resync
276 function Parse_Exception_Handlers
return List_Id
is
278 Handlers_List
: List_Id
;
281 Handlers_List
:= New_List
;
282 P_Pragmas_Opt
(Handlers_List
);
284 if Token
= Tok_End
then
285 Error_Msg_SC
("must have at least one exception handler!");
289 Handler
:= P_Exception_Handler
;
290 Append
(Handler
, Handlers_List
);
292 -- Note: no need to check for pragmas here. Although the
293 -- syntax officially allows them in this position, they
294 -- will have been swallowed up as part of the statement
295 -- sequence of the handler we just scanned out.
297 exit when Token
/= Tok_When
;
301 return Handlers_List
;
302 end Parse_Exception_Handlers
;