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