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-2012, 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 Statement -- 204 --------------------------- 205 206 -- RAISE_STATEMENT ::= raise [exception_NAME]; 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_Statement return Node_Id is 213 Raise_Node : Node_Id; 214 215 begin 216 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr); 217 Scan; -- past RAISE 218 219 if Token /= Tok_Semicolon then 220 Set_Name (Raise_Node, P_Name); 221 end if; 222 223 if Token = Tok_With then 224 if Ada_Version < Ada_2005 then 225 Error_Msg_SC ("string expression in raise is Ada 2005 extension"); 226 Error_Msg_SC ("\unit must be compiled with -gnat05 switch"); 227 end if; 228 229 Scan; -- past WITH 230 Set_Expression (Raise_Node, P_Expression); 231 end if; 232 233 TF_Semicolon; 234 return Raise_Node; 235 end P_Raise_Statement; 236 237 ------------------------------ 238 -- Parse_Exception_Handlers -- 239 ------------------------------ 240 241 -- This routine scans out a list of exception handlers appearing in a 242 -- construct as: 243 244 -- exception 245 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER} 246 247 -- The caller has scanned out the EXCEPTION keyword 248 249 -- Control returns after scanning the last exception handler, presumably 250 -- at the keyword END, but this is not checked in this routine. 251 252 -- Error recovery: cannot raise Error_Resync 253 254 function Parse_Exception_Handlers return List_Id is 255 Handler : Node_Id; 256 Handlers_List : List_Id; 257 Handler_Is_Hidden_In_SPARK : Boolean; 258 Hidden_Region_Start : Source_Ptr; 259 260 begin 261 -- In SPARK, a HIDE directive can be placed at the beginning of a 262 -- sequence of exception handlers for a subprogram implementation, thus 263 -- hiding the exception handlers from SPARK tool-set. No violation of 264 -- the SPARK restriction should be issued on nodes in a hidden part, 265 -- which is obtained by marking such hidden parts. 266 267 if Token = Tok_SPARK_Hide then 268 Handler_Is_Hidden_In_SPARK := True; 269 Hidden_Region_Start := Token_Ptr; 270 Scan; -- past HIDE directive 271 else 272 Handler_Is_Hidden_In_SPARK := False; 273 end if; 274 275 Handlers_List := New_List; 276 P_Pragmas_Opt (Handlers_List); 277 278 if Token = Tok_End then 279 Error_Msg_SC ("must have at least one exception handler!"); 280 281 else 282 loop 283 Handler := P_Exception_Handler; 284 Append (Handler, Handlers_List); 285 286 -- Note: no need to check for pragmas here. Although the 287 -- syntax officially allows them in this position, they 288 -- will have been swallowed up as part of the statement 289 -- sequence of the handler we just scanned out. 290 291 exit when Token /= Tok_When; 292 end loop; 293 end if; 294 295 if Handler_Is_Hidden_In_SPARK then 296 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr); 297 end if; 298 299 return Handlers_List; 300 end Parse_Exception_Handlers; 301 302end Ch11; 303