1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks
(All_Checks
);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
32 with Sinfo
.CN
; use Sinfo
.CN
;
37 -- Local functions, used only in this chapter
39 function P_Exception_Handler
return Node_Id
;
40 function P_Exception_Choice
return Node_Id
;
42 ---------------------------------
43 -- 11.1 Exception Declaration --
44 ---------------------------------
46 -- Parsed by P_Identifier_Declaration (3.3.1)
48 ------------------------------------------
49 -- 11.2 Handled Sequence Of Statements --
50 ------------------------------------------
52 -- HANDLED_SEQUENCE_OF_STATEMENTS ::=
53 -- SEQUENCE_OF_STATEMENTS
56 -- {EXCEPTION_HANDLER}]
58 -- Error_Recovery : Cannot raise Error_Resync
60 function P_Handled_Sequence_Of_Statements
return Node_Id
is
61 Handled_Stmt_Seq_Node
: Node_Id
;
64 Handled_Stmt_Seq_Node
:=
65 New_Node
(N_Handled_Sequence_Of_Statements
, Token_Ptr
);
67 (Handled_Stmt_Seq_Node
, P_Sequence_Of_Statements
(SS_Extm_Sreq
));
69 if Token
= Tok_Exception
then
70 Scan
; -- past EXCEPTION
71 Set_Exception_Handlers
72 (Handled_Stmt_Seq_Node
, Parse_Exception_Handlers
);
75 return Handled_Stmt_Seq_Node
;
76 end P_Handled_Sequence_Of_Statements
;
78 -----------------------------
79 -- 11.2 Exception Handler --
80 -----------------------------
82 -- EXCEPTION_HANDLER ::=
83 -- when [CHOICE_PARAMETER_SPECIFICATION :]
84 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
85 -- SEQUENCE_OF_STATEMENTS
87 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
89 -- Error recovery: cannot raise Error_Resync
91 function P_Exception_Handler
return Node_Id
is
92 Scan_State
: Saved_Scan_State
;
93 Handler_Node
: Node_Id
;
94 Choice_Param_Node
: Node_Id
;
97 Handler_Node
:= New_Node
(N_Exception_Handler
, Token_Ptr
);
100 -- Test for possible choice parameter present
102 if Token
= Tok_Identifier
then
103 Choice_Param_Node
:= Token_Node
;
104 Save_Scan_State
(Scan_State
); -- at identifier
105 Scan
; -- past identifier
107 if Token
= Tok_Colon
then
109 Error_Msg_SP
("(Ada 83) choice parameter not allowed!");
113 Change_Identifier_To_Defining_Identifier
(Choice_Param_Node
);
114 Set_Choice_Parameter
(Handler_Node
, Choice_Param_Node
);
116 elsif Token
= Tok_Others
then
117 Error_Msg_AP
("missing "":""");
118 Change_Identifier_To_Defining_Identifier
(Choice_Param_Node
);
119 Set_Choice_Parameter
(Handler_Node
, Choice_Param_Node
);
122 Restore_Scan_State
(Scan_State
); -- to identifier
126 -- Loop through exception choices
128 Set_Exception_Choices
(Handler_Node
, New_List
);
131 Append
(P_Exception_Choice
, Exception_Choices
(Handler_Node
));
132 exit when Token
/= Tok_Vertical_Bar
;
133 Scan
; -- past vertical bar
137 Set_Statements
(Handler_Node
, P_Sequence_Of_Statements
(SS_Sreq_Whtm
));
139 end P_Exception_Handler
;
141 ------------------------------------------
142 -- 11.2 Choice Parameter Specification --
143 ------------------------------------------
145 -- Parsed by P_Exception_Handler (11.2)
147 ----------------------------
148 -- 11.2 Exception Choice --
149 ----------------------------
151 -- EXCEPTION_CHOICE ::= exception_NAME | others
153 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
154 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
156 function P_Exception_Choice
return Node_Id
is
159 if Token
= Tok_Others
then
161 return New_Node
(N_Others_Choice
, Prev_Token_Ptr
);
164 return P_Name
; -- exception name
171 end P_Exception_Choice
;
173 ---------------------------
174 -- 11.3 Raise Statement --
175 ---------------------------
177 -- RAISE_STATEMENT ::= raise [exception_NAME];
179 -- The caller has verified that the initial token is RAISE
181 -- Error recovery: can raise Error_Resync
183 function P_Raise_Statement
return Node_Id
is
184 Raise_Node
: Node_Id
;
187 Raise_Node
:= New_Node
(N_Raise_Statement
, Token_Ptr
);
190 if Token
/= Tok_Semicolon
then
191 Set_Name
(Raise_Node
, P_Name
);
196 end P_Raise_Statement
;
198 ------------------------------
199 -- Parse_Exception_Handlers --
200 ------------------------------
202 -- This routine scans out a list of exception handlers appearing in a
206 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
208 -- The caller has scanned out the EXCEPTION keyword
210 -- Control returns after scanning the last exception handler, presumably
211 -- at the keyword END, but this is not checked in this routine.
213 -- Error recovery: cannot raise Error_Resync
215 function Parse_Exception_Handlers
return List_Id
is
217 Handlers_List
: List_Id
;
218 Pragmas_List
: List_Id
;
221 Handlers_List
:= New_List
;
222 P_Pragmas_Opt
(Handlers_List
);
224 if Token
= Tok_End
then
225 Error_Msg_SC
("must have at least one exception handler!");
229 Handler
:= P_Exception_Handler
;
230 Pragmas_List
:= No_List
;
231 Append
(Handler
, Handlers_List
);
233 -- Note: no need to check for pragmas here. Although the
234 -- syntax officially allows them in this position, they
235 -- will have been swallowed up as part of the statement
236 -- sequence of the handler we just scanned out.
238 exit when Token
/= Tok_When
;
242 return Handlers_List
;
243 end Parse_Exception_Handlers
;