gcc/ada/par-ch11.adb

   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-2018, 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
  26 pragma Style_Checks (All_Checks);
  27 --  Turn off subprogram body ordering check. Subprograms are in order
  28 --  by RM section rather than alphabetical
  29
  30 with Sinfo.CN; use Sinfo.CN;
  31
  32 separate (Par)
  33 package 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
 330 end Ch11;