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