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-2021, 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------------------------------------------------------------------------------ 25 26pragma Style_Checks (All_Checks); 27-- Turn off subprogram body ordering check. Subprograms are in order 28-- by RM section rather than alphabetical 29 30with Sinfo.CN; use Sinfo.CN; 31 32separate (Par) 33package body Ch11 is 34 35 -- Local functions, used only in this chapter 36 37 function P_Exception_Handler return Node_Id; 38 function P_Exception_Choice return Node_Id; 39 40 --------------------------------- 41 -- 11.1 Exception Declaration -- 42 --------------------------------- 43 44 -- Parsed by P_Identifier_Declaration (3.3.1) 45 46 ------------------------------------------ 47 -- 11.2 Handled Sequence Of Statements -- 48 ------------------------------------------ 49 50 -- HANDLED_SEQUENCE_OF_STATEMENTS ::= 51 -- SEQUENCE_OF_STATEMENTS 52 -- [exception 53 -- EXCEPTION_HANDLER 54 -- {EXCEPTION_HANDLER}] 55 56 -- Error_Recovery : Cannot raise Error_Resync 57 58 function P_Handled_Sequence_Of_Statements return Node_Id is 59 Handled_Stmt_Seq_Node : Node_Id; 60 begin 61 Handled_Stmt_Seq_Node := 62 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr); 63 Set_Statements 64 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq)); 65 66 if Token = Tok_Exception then 67 Scan; -- past EXCEPTION 68 Set_Exception_Handlers 69 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers); 70 end if; 71 72 return Handled_Stmt_Seq_Node; 73 end P_Handled_Sequence_Of_Statements; 74 75 ----------------------------- 76 -- 11.2 Exception Handler -- 77 ----------------------------- 78 79 -- EXCEPTION_HANDLER ::= 80 -- when [CHOICE_PARAMETER_SPECIFICATION :] 81 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} => 82 -- SEQUENCE_OF_STATEMENTS 83 84 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER 85 86 -- Error recovery: cannot raise Error_Resync 87 88 function P_Exception_Handler return Node_Id is 89 Scan_State : Saved_Scan_State; 90 Handler_Node : Node_Id; 91 Choice_Param_Node : Node_Id; 92 93 begin 94 Exception_Handler_Encountered := True; 95 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr); 96 Set_Local_Raise_Statements (Handler_Node, No_Elist); 97 98 if Style_Check then 99 Style.Check_Indentation; 100 end if; 101 102 T_When; 103 104 -- Test for possible choice parameter present 105 106 if Token = Tok_Identifier then 107 Choice_Param_Node := Token_Node; 108 Save_Scan_State (Scan_State); -- at identifier 109 Scan; -- past identifier 110 111 if Token = Tok_Colon then 112 if Ada_Version = Ada_83 then 113 Error_Msg_SP ("(Ada 83) choice parameter not allowed!"); 114 end if; 115 116 Scan; -- past : 117 Change_Identifier_To_Defining_Identifier (Choice_Param_Node); 118 Warn_If_Standard_Redefinition (Choice_Param_Node); 119 Set_Choice_Parameter (Handler_Node, Choice_Param_Node); 120 121 elsif Token = Tok_Others then 122 Error_Msg_AP -- CODEFIX 123 ("missing "":"""); 124 Change_Identifier_To_Defining_Identifier (Choice_Param_Node); 125 Warn_If_Standard_Redefinition (Choice_Param_Node); 126 Set_Choice_Parameter (Handler_Node, Choice_Param_Node); 127 128 else 129 Restore_Scan_State (Scan_State); -- to identifier 130 end if; 131 end if; 132 133 -- Loop through exception choices 134 135 Set_Exception_Choices (Handler_Node, New_List); 136 137 loop 138 Append (P_Exception_Choice, Exception_Choices (Handler_Node)); 139 exit when Token /= Tok_Vertical_Bar; 140 Scan; -- past vertical bar 141 end loop; 142 143 TF_Arrow; 144 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm)); 145 return Handler_Node; 146 end P_Exception_Handler; 147 148 ------------------------------------------ 149 -- 11.2 Choice Parameter Specification -- 150 ------------------------------------------ 151 152 -- Parsed by P_Exception_Handler (11.2) 153 154 ---------------------------- 155 -- 11.2 Exception Choice -- 156 ---------------------------- 157 158 -- EXCEPTION_CHOICE ::= exception_NAME | others 159 160 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the 161 -- scan pointer is advanced to the next arrow or vertical bar or semicolon. 162 163 function P_Exception_Choice return Node_Id is 164 begin 165 166 if Token = Tok_Others then 167 Scan; -- past OTHERS 168 return New_Node (N_Others_Choice, Prev_Token_Ptr); 169 170 else 171 return P_Name; -- exception name 172 end if; 173 174 exception 175 when Error_Resync => 176 Resync_Choice; 177 return Error; 178 end P_Exception_Choice; 179 180 ---------------------------- 181 -- 11.3 Raise Expression -- 182 ---------------------------- 183 184 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]] 185 186 -- The caller has verified that the initial token is RAISE 187 188 -- Error recovery: can raise Error_Resync 189 190 function P_Raise_Expression return Node_Id is 191 Raise_Node : Node_Id; 192 193 begin 194 Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr); 195 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr); 196 Scan; -- past RAISE 197 198 Set_Name (Raise_Node, P_Name); 199 200 if Token = Tok_With then 201 Scan; -- past WITH 202 Set_Expression (Raise_Node, P_Expression); 203 end if; 204 205 return Raise_Node; 206 end P_Raise_Expression; 207 208 --------------------------- 209 -- 11.3 Raise Statement -- 210 --------------------------- 211 212 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION]; 213 214 -- The caller has verified that the initial token is RAISE 215 216 -- Error recovery: can raise Error_Resync 217 218 function P_Raise_Statement return Node_Id is 219 Raise_Node : Node_Id; 220 221 begin 222 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr); 223 Scan; -- past RAISE 224 225 if Token /= Tok_Semicolon then 226 Set_Name (Raise_Node, P_Name); 227 end if; 228 229 if Token = Tok_With then 230 Error_Msg_Ada_2005_Extension ("string expression in raise"); 231 232 Scan; -- past WITH 233 Set_Expression (Raise_Node, P_Expression); 234 end if; 235 236 if Token = Tok_When then 237 Error_Msg_GNAT_Extension ("raise when statement"); 238 239 Mutate_Nkind (Raise_Node, N_Raise_When_Statement); 240 241 if Token = Tok_When and then not Missing_Semicolon_On_When then 242 Scan; -- past WHEN 243 Set_Condition (Raise_Node, P_Expression_No_Right_Paren); 244 245 -- Allow IF instead of WHEN, giving error message 246 247 elsif Token = Tok_If then 248 T_When; 249 Scan; -- past IF used in place of WHEN 250 Set_Condition (Raise_Node, P_Expression_No_Right_Paren); 251 end if; 252 end if; 253 254 TF_Semicolon; 255 return Raise_Node; 256 end P_Raise_Statement; 257 258 ------------------------------ 259 -- Parse_Exception_Handlers -- 260 ------------------------------ 261 262 -- This routine scans out a list of exception handlers appearing in a 263 -- construct as: 264 265 -- exception 266 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER} 267 268 -- The caller has scanned out the EXCEPTION keyword 269 270 -- Control returns after scanning the last exception handler, presumably 271 -- at the keyword END, but this is not checked in this routine. 272 273 -- Error recovery: cannot raise Error_Resync 274 275 function Parse_Exception_Handlers return List_Id is 276 Handler : Node_Id; 277 Handlers_List : List_Id; 278 279 begin 280 Handlers_List := New_List; 281 P_Pragmas_Opt (Handlers_List); 282 283 if Token = Tok_End then 284 Error_Msg_SC ("must have at least one exception handler!"); 285 286 else 287 loop 288 Handler := P_Exception_Handler; 289 Append (Handler, Handlers_List); 290 291 -- Note: no need to check for pragmas here. Although the 292 -- syntax officially allows them in this position, they 293 -- will have been swallowed up as part of the statement 294 -- sequence of the handler we just scanned out. 295 296 exit when Token /= Tok_When; 297 end loop; 298 end if; 299 300 return Handlers_List; 301 end Parse_Exception_Handlers; 302 303end Ch11; 304