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-2013, 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 Seq_Is_Hidden_In_SPARK : Boolean; 61 Hidden_Region_Start : Source_Ptr; 62 63 begin 64 Handled_Stmt_Seq_Node := 65 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr); 66 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. 72 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 77 else 78 Seq_Is_Hidden_In_SPARK := False; 79 end if; 80 81 Set_Statements 82 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq)); 83 84 if Token = Tok_Exception then 85 Scan; -- past EXCEPTION 86 Set_Exception_Handlers 87 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers); 88 end if; 89 90 if Seq_Is_Hidden_In_SPARK then 91 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); 92 end if; 93 94 return Handled_Stmt_Seq_Node; 95 end P_Handled_Sequence_Of_Statements; 96 97 ----------------------------- 98 -- 11.2 Exception Handler -- 99 ----------------------------- 100 101 -- EXCEPTION_HANDLER ::= 102 -- when [CHOICE_PARAMETER_SPECIFICATION :] 103 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} => 104 -- SEQUENCE_OF_STATEMENTS 105 106 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER 107 108 -- Error recovery: cannot raise Error_Resync 109 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; 114 115 begin 116 Exception_Handler_Encountered := True; 117 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr); 118 Set_Local_Raise_Statements (Handler_Node, No_Elist); 119 120 if Style_Check then 121 Style.Check_Indentation; 122 end if; 123 124 T_When; 125 126 -- Test for possible choice parameter present 127 128 if Token = Tok_Identifier then 129 Choice_Param_Node := Token_Node; 130 Save_Scan_State (Scan_State); -- at identifier 131 Scan; -- past identifier 132 133 if Token = Tok_Colon then 134 if Ada_Version = Ada_83 then 135 Error_Msg_SP ("(Ada 83) choice parameter not allowed!"); 136 end if; 137 138 Scan; -- past : 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); 142 143 elsif Token = Tok_Others then 144 Error_Msg_AP -- CODEFIX 145 ("missing "":"""); 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); 149 150 else 151 Restore_Scan_State (Scan_State); -- to identifier 152 end if; 153 end if; 154 155 -- Loop through exception choices 156 157 Set_Exception_Choices (Handler_Node, New_List); 158 159 loop 160 Append (P_Exception_Choice, Exception_Choices (Handler_Node)); 161 exit when Token /= Tok_Vertical_Bar; 162 Scan; -- past vertical bar 163 end loop; 164 165 TF_Arrow; 166 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm)); 167 return Handler_Node; 168 end P_Exception_Handler; 169 170 ------------------------------------------ 171 -- 11.2 Choice Parameter Specification -- 172 ------------------------------------------ 173 174 -- Parsed by P_Exception_Handler (11.2) 175 176 ---------------------------- 177 -- 11.2 Exception Choice -- 178 ---------------------------- 179 180 -- EXCEPTION_CHOICE ::= exception_NAME | others 181 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. 184 185 function P_Exception_Choice return Node_Id is 186 begin 187 188 if Token = Tok_Others then 189 Scan; -- past OTHERS 190 return New_Node (N_Others_Choice, Prev_Token_Ptr); 191 192 else 193 return P_Name; -- exception name 194 end if; 195 196 exception 197 when Error_Resync => 198 Resync_Choice; 199 return Error; 200 end P_Exception_Choice; 201 202 ---------------------------- 203 -- 11.3 Raise Expression -- 204 ---------------------------- 205 206 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]] 207 208 -- The caller has verified that the initial token is RAISE 209 210 -- Error recovery: can raise Error_Resync 211 212 function P_Raise_Expression return Node_Id is 213 Raise_Node : Node_Id; 214 215 begin 216 Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr); 217 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr); 218 Scan; -- past RAISE 219 220 Set_Name (Raise_Node, P_Name); 221 222 if Token = Tok_With then 223 Scan; -- past WITH 224 Set_Expression (Raise_Node, P_Expression); 225 end if; 226 227 return Raise_Node; 228 end P_Raise_Expression; 229 230 --------------------------- 231 -- 11.3 Raise Statement -- 232 --------------------------- 233 234 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION]; 235 236 -- The caller has verified that the initial token is RAISE 237 238 -- Error recovery: can raise Error_Resync 239 240 function P_Raise_Statement return Node_Id is 241 Raise_Node : Node_Id; 242 243 begin 244 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr); 245 Scan; -- past RAISE 246 247 if Token /= Tok_Semicolon then 248 Set_Name (Raise_Node, P_Name); 249 end if; 250 251 if Token = Tok_With then 252 if Ada_Version < Ada_2005 then 253 Error_Msg_SC ("string expression in raise is Ada 2005 extension"); 254 Error_Msg_SC ("\unit must be compiled with -gnat05 switch"); 255 end if; 256 257 Scan; -- past WITH 258 Set_Expression (Raise_Node, P_Expression); 259 end if; 260 261 TF_Semicolon; 262 return Raise_Node; 263 end P_Raise_Statement; 264 265 ------------------------------ 266 -- Parse_Exception_Handlers -- 267 ------------------------------ 268 269 -- This routine scans out a list of exception handlers appearing in a 270 -- construct as: 271 272 -- exception 273 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER} 274 275 -- The caller has scanned out the EXCEPTION keyword 276 277 -- Control returns after scanning the last exception handler, presumably 278 -- at the keyword END, but this is not checked in this routine. 279 280 -- Error recovery: cannot raise Error_Resync 281 282 function Parse_Exception_Handlers return List_Id is 283 Handler : Node_Id; 284 Handlers_List : List_Id; 285 Handler_Is_Hidden_In_SPARK : Boolean; 286 Hidden_Region_Start : Source_Ptr; 287 288 begin 289 -- In SPARK, a HIDE directive can be placed at the beginning of a 290 -- sequence of exception handlers for a subprogram implementation, thus 291 -- hiding the exception handlers from SPARK tool-set. No violation of 292 -- the SPARK restriction should be issued on nodes in a hidden part, 293 -- which is obtained by marking such hidden parts. 294 295 if Token = Tok_SPARK_Hide then 296 Handler_Is_Hidden_In_SPARK := True; 297 Hidden_Region_Start := Token_Ptr; 298 Scan; -- past HIDE directive 299 else 300 Handler_Is_Hidden_In_SPARK := False; 301 end if; 302 303 Handlers_List := New_List; 304 P_Pragmas_Opt (Handlers_List); 305 306 if Token = Tok_End then 307 Error_Msg_SC ("must have at least one exception handler!"); 308 309 else 310 loop 311 Handler := P_Exception_Handler; 312 Append (Handler, Handlers_List); 313 314 -- Note: no need to check for pragmas here. Although the 315 -- syntax officially allows them in this position, they 316 -- will have been swallowed up as part of the statement 317 -- sequence of the handler we just scanned out. 318 319 exit when Token /= Tok_When; 320 end loop; 321 end if; 322 323 if Handler_Is_Hidden_In_SPARK then 324 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); 325 end if; 326 327 return Handlers_List; 328 end Parse_Exception_Handlers; 329 330end Ch11; 331