1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 pragma Style_Checks (All_Checks);
30 -- Turn off subprogram body ordering check. Subprograms are in order
31 -- by RM section rather than alphabetical
33 with Sinfo.CN; use Sinfo.CN;
38 -- Local functions, used only in this chapter
40 function P_Exception_Handler return Node_Id;
41 function P_Exception_Choice return Node_Id;
43 ---------------------------------
44 -- 11.1 Exception Declaration --
45 ---------------------------------
47 -- Parsed by P_Identifier_Declaration (3.3.1)
49 ------------------------------------------
50 -- 11.2 Handled Sequence Of Statements --
51 ------------------------------------------
53 -- HANDLED_SEQUENCE_OF_STATEMENTS ::=
54 -- SEQUENCE_OF_STATEMENTS
57 -- {EXCEPTION_HANDLER}]
59 -- Error_Recovery : Cannot raise Error_Resync
61 function P_Handled_Sequence_Of_Statements return Node_Id is
62 Handled_Stmt_Seq_Node : Node_Id;
65 Handled_Stmt_Seq_Node :=
66 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
68 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
70 if Token = Tok_Exception then
71 Scan; -- past EXCEPTION
72 Set_Exception_Handlers
73 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
76 return Handled_Stmt_Seq_Node;
77 end P_Handled_Sequence_Of_Statements;
79 -----------------------------
80 -- 11.2 Exception Handler --
81 -----------------------------
83 -- EXCEPTION_HANDLER ::=
84 -- when [CHOICE_PARAMETER_SPECIFICATION :]
85 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
86 -- SEQUENCE_OF_STATEMENTS
88 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
90 -- Error recovery: cannot raise Error_Resync
92 function P_Exception_Handler return Node_Id is
93 Scan_State : Saved_Scan_State;
94 Handler_Node : Node_Id;
95 Choice_Param_Node : Node_Id;
98 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
101 -- Test for possible choice parameter present
103 if Token = Tok_Identifier then
104 Choice_Param_Node := Token_Node;
105 Save_Scan_State (Scan_State); -- at identifier
106 Scan; -- past identifier
108 if Token = Tok_Colon then
110 Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
114 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
115 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
117 elsif Token = Tok_Others then
118 Error_Msg_AP ("missing "":""");
119 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
120 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
123 Restore_Scan_State (Scan_State); -- to identifier
127 -- Loop through exception choices
129 Set_Exception_Choices (Handler_Node, New_List);
132 Append (P_Exception_Choice, Exception_Choices (Handler_Node));
133 exit when Token /= Tok_Vertical_Bar;
134 Scan; -- past vertical bar
138 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
140 end P_Exception_Handler;
142 ------------------------------------------
143 -- 11.2 Choice Parameter Specification --
144 ------------------------------------------
146 -- Parsed by P_Exception_Handler (11.2)
148 ----------------------------
149 -- 11.2 Exception Choice --
150 ----------------------------
152 -- EXCEPTION_CHOICE ::= exception_NAME | others
154 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
155 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
157 function P_Exception_Choice return Node_Id is
160 if Token = Tok_Others then
162 return New_Node (N_Others_Choice, Prev_Token_Ptr);
165 return P_Name; -- exception name
172 end P_Exception_Choice;
174 ---------------------------
175 -- 11.3 Raise Statement --
176 ---------------------------
178 -- RAISE_STATEMENT ::= raise [exception_NAME];
180 -- The caller has verified that the initial token is RAISE
182 -- Error recovery: can raise Error_Resync
184 function P_Raise_Statement return Node_Id is
185 Raise_Node : Node_Id;
188 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
191 if Token /= Tok_Semicolon then
192 Set_Name (Raise_Node, P_Name);
197 end P_Raise_Statement;
199 ------------------------------
200 -- Parse_Exception_Handlers --
201 ------------------------------
203 -- This routine scans out a list of exception handlers appearing in a
207 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
209 -- The caller has scanned out the EXCEPTION keyword
211 -- Control returns after scanning the last exception handler, presumably
212 -- at the keyword END, but this is not checked in this routine.
214 -- Error recovery: cannot raise Error_Resync
216 function Parse_Exception_Handlers return List_Id is
218 Handlers_List : List_Id;
219 Pragmas_List : List_Id;
222 Handlers_List := New_List;
223 P_Pragmas_Opt (Handlers_List);
225 if Token = Tok_End then
226 Error_Msg_SC ("must have at least one exception handler!");
230 Handler := P_Exception_Handler;
231 Pragmas_List := No_List;
232 Append (Handler, Handlers_List);
234 -- Note: no need to check for pragmas here. Although the
235 -- syntax officially allows them in this position, they
236 -- will have been swallowed up as part of the statement
237 -- sequence of the handler we just scanned out.
239 exit when Token /= Tok_When;
243 return Handlers_List;
244 end Parse_Exception_Handlers;