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-2006, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 pragma Style_Checks (All_Checks);
  28 --  Turn off subprogram body ordering check. Subprograms are in order
  29 --  by RM section rather than alphabetical
  30
  31 with Sinfo.CN; use Sinfo.CN;
  32
  33 separate (Par)
  34 package body Ch11 is
  35
  36    --  Local functions, used only in this chapter
  37
  38    function P_Exception_Handler  return Node_Id;
  39    function P_Exception_Choice   return Node_Id;
  40
  41    ---------------------------------
  42    -- 11.1  Exception Declaration --
  43    ---------------------------------
  44
  45    --  Parsed by P_Identifier_Declaration (3.3.1)
  46
  47    ------------------------------------------
  48    -- 11.2  Handled Sequence Of Statements --
  49    ------------------------------------------
  50
  51    --  HANDLED_SEQUENCE_OF_STATEMENTS ::=
  52    --      SEQUENCE_OF_STATEMENTS
  53    --    [exception
  54    --      EXCEPTION_HANDLER
  55    --      {EXCEPTION_HANDLER}]
  56
  57    --  Error_Recovery : Cannot raise Error_Resync
  58
  59    function P_Handled_Sequence_Of_Statements return Node_Id is
  60       Handled_Stmt_Seq_Node : Node_Id;
  61
  62    begin
  63       Handled_Stmt_Seq_Node :=
  64         New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
  65       Set_Statements
  66         (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
  67
  68       if Token = Tok_Exception then
  69          Scan; -- past EXCEPTION
  70          Set_Exception_Handlers
  71            (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
  72       end if;
  73
  74       return Handled_Stmt_Seq_Node;
  75    end P_Handled_Sequence_Of_Statements;
  76
  77    -----------------------------
  78    -- 11.2  Exception Handler --
  79    -----------------------------
  80
  81    --  EXCEPTION_HANDLER ::=
  82    --    when [CHOICE_PARAMETER_SPECIFICATION :]
  83    --      EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
  84    --        SEQUENCE_OF_STATEMENTS
  85
  86    --  CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
  87
  88    --  Error recovery: cannot raise Error_Resync
  89
  90    function P_Exception_Handler return Node_Id is
  91       Scan_State        : Saved_Scan_State;
  92       Handler_Node      : Node_Id;
  93       Choice_Param_Node : Node_Id;
  94
  95    begin
  96       Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
  97       Set_Local_Raise_Statements (Handler_Node, No_Elist);
  98       T_When;
  99
 100       --  Test for possible choice parameter present
 101
 102       if Token = Tok_Identifier then
 103          Choice_Param_Node := Token_Node;
 104          Save_Scan_State (Scan_State); -- at identifier
 105          Scan; -- past identifier
 106
 107          if Token = Tok_Colon then
 108             if Ada_Version = Ada_83 then
 109                Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
 110             end if;
 111
 112             Scan; -- past :
 113             Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
 114             Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
 115
 116          elsif Token = Tok_Others then
 117             Error_Msg_AP ("missing "":""");
 118             Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
 119             Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
 120
 121          else
 122             Restore_Scan_State (Scan_State); -- to identifier
 123          end if;
 124       end if;
 125
 126       --  Loop through exception choices
 127
 128       Set_Exception_Choices (Handler_Node, New_List);
 129
 130       loop
 131          Append (P_Exception_Choice, Exception_Choices (Handler_Node));
 132          exit when Token /= Tok_Vertical_Bar;
 133          Scan; -- past vertical bar
 134       end loop;
 135
 136       TF_Arrow;
 137       Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
 138       return Handler_Node;
 139    end P_Exception_Handler;
 140
 141    ------------------------------------------
 142    -- 11.2  Choice Parameter Specification --
 143    ------------------------------------------
 144
 145    --  Parsed by P_Exception_Handler (11.2)
 146
 147    ----------------------------
 148    -- 11.2  Exception Choice --
 149    ----------------------------
 150
 151    --  EXCEPTION_CHOICE ::= exception_NAME | others
 152
 153    --  Error recovery: cannot raise Error_Resync. If an error occurs, then the
 154    --  scan pointer is advanced to the next arrow or vertical bar or semicolon.
 155
 156    function P_Exception_Choice return Node_Id is
 157    begin
 158
 159       if Token = Tok_Others then
 160          Scan; -- past OTHERS
 161          return New_Node (N_Others_Choice, Prev_Token_Ptr);
 162
 163       else
 164          return P_Name; -- exception name
 165       end if;
 166
 167    exception
 168       when Error_Resync =>
 169          Resync_Choice;
 170          return Error;
 171    end P_Exception_Choice;
 172
 173    ---------------------------
 174    -- 11.3  Raise Statement --
 175    ---------------------------
 176
 177    --  RAISE_STATEMENT ::= raise [exception_NAME];
 178
 179    --  The caller has verified that the initial token is RAISE
 180
 181    --  Error recovery: can raise Error_Resync
 182
 183    function P_Raise_Statement return Node_Id is
 184       Raise_Node : Node_Id;
 185
 186    begin
 187       Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
 188       Scan; -- past RAISE
 189
 190       if Token /= Tok_Semicolon then
 191          Set_Name (Raise_Node, P_Name);
 192       end if;
 193
 194       if Token = Tok_With then
 195          if Ada_Version < Ada_05 then
 196             Error_Msg_SC ("string expression in raise is Ada 2005 extension");
 197             Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
 198          end if;
 199
 200          Scan; -- past WITH
 201          Set_Expression (Raise_Node, P_Expression);
 202       end if;
 203
 204       TF_Semicolon;
 205       return Raise_Node;
 206    end P_Raise_Statement;
 207
 208    ------------------------------
 209    -- Parse_Exception_Handlers --
 210    ------------------------------
 211
 212    --  This routine scans out a list of exception handlers appearing in a
 213    --  construct as:
 214
 215    --    exception
 216    --      EXCEPTION_HANDLER {EXCEPTION_HANDLER}
 217
 218    --  The caller has scanned out the EXCEPTION keyword
 219
 220    --  Control returns after scanning the last exception handler, presumably
 221    --  at the keyword END, but this is not checked in this routine.
 222
 223    --  Error recovery: cannot raise Error_Resync
 224
 225    function Parse_Exception_Handlers return List_Id is
 226       Handler       : Node_Id;
 227       Handlers_List : List_Id;
 228
 229    begin
 230       Handlers_List := New_List;
 231       P_Pragmas_Opt (Handlers_List);
 232
 233       if Token = Tok_End then
 234          Error_Msg_SC ("must have at least one exception handler!");
 235
 236       else
 237          loop
 238             Handler := P_Exception_Handler;
 239             Append (Handler, Handlers_List);
 240
 241             --  Note: no need to check for pragmas here. Although the
 242             --  syntax officially allows them in this position, they
 243             --  will have been swallowed up as part of the statement
 244             --  sequence of the handler we just scanned out.
 245
 246             exit when Token /= Tok_When;
 247          end loop;
 248       end if;
 249
 250       return Handlers_List;
 251    end Parse_Exception_Handlers;
 252
 253 end Ch11;