2009-09-21 Joel Sherrill <joel.sherrill@oarcorp.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / par-ch12.adb

diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 84be97a..046ac43 100644 (file)
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,18 +6,17 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
 -- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
@@ -101,7 +100,8 @@ package body Ch12 is
       Scan; -- past GENERIC
 
       if Token = Tok_Private then
-         Error_Msg_SC ("PRIVATE goes before GENERIC, not after");
+         Error_Msg_SC -- CODEFIX
+           ("PRIVATE goes before GENERIC, not after");
          Scan; -- past junk PRIVATE token
       end if;
 
@@ -180,7 +180,7 @@ package body Ch12 is
                   Append (P_Formal_Subprogram_Declaration, Decls);
 
                else
-                  Error_Msg_BC
+                  Error_Msg_BC -- CODEFIX
                     ("FUNCTION, PROCEDURE or PACKAGE expected here");
                   Resync_Past_Semicolon;
                end if;
@@ -332,13 +332,13 @@ package body Ch12 is
    begin
       Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr);
 
-      --  Ada2005: an association can be given by: others => <>.
+      --  Ada2005: an association can be given by: others => <>
 
       if Token = Tok_Others then
          if Ada_Version < Ada_05 then
             Error_Msg_SP
               ("partial parametrization of formal packages" &
-                "  is an Ada 2005 extension");
+                " is an Ada 2005 extension");
             Error_Msg_SP
               ("\unit must be compiled with -gnat05 switch");
          end if;
@@ -357,7 +357,9 @@ package body Ch12 is
             Scan;  --  past box
          end if;
 
-         return New_Node (N_Others_Choice, Token_Ptr);
+         --  Source position of the others choice is beginning of construct
+
+         return New_Node (N_Others_Choice, Sloc (Generic_Assoc_Node));
       end if;
 
       if Token in Token_Class_Desig then
@@ -373,7 +375,7 @@ package body Ch12 is
          end if;
       end if;
 
-      --  In Ada 2005 the actual can be a box.
+      --  In Ada 2005 the actual can be a box
 
       if Token = Tok_Box then
          Scan;
@@ -656,7 +658,8 @@ package body Ch12 is
 
             else
                if Token = Tok_Abstract then
-                  Error_Msg_SC ("ABSTRACT must come before LIMITED");
+                  Error_Msg_SC -- CODEFIX
+                    ("ABSTRACT must come before LIMITED");
                   Scan;  --  past improper ABSTRACT
 
                   if Token = Tok_New then
@@ -679,6 +682,18 @@ package body Ch12 is
          when Tok_New =>
             return P_Formal_Derived_Type_Definition;
 
+         when Tok_Not =>
+            if P_Null_Exclusion then
+               Typedef_Node :=  P_Access_Type_Definition;
+               Set_Null_Exclusion_Present (Typedef_Node);
+               return Typedef_Node;
+
+            else
+               Error_Msg_SC ("expect valid formal access definition!");
+               Resync_Past_Semicolon;
+               return Error;
+            end if;
+
          when Tok_Private |
               Tok_Tagged  =>
             return P_Formal_Private_Type_Definition;
@@ -792,15 +807,18 @@ package body Ch12 is
 
       if Token = Tok_Abstract then
          if Prev_Token = Tok_Tagged then
-            Error_Msg_SC ("ABSTRACT must come before TAGGED");
+            Error_Msg_SC -- CODEFIX
+              ("ABSTRACT must come before TAGGED");
          elsif Prev_Token = Tok_Limited then
-            Error_Msg_SC ("ABSTRACT must come before LIMITED");
+            Error_Msg_SC -- CODEFIX
+              ("ABSTRACT must come before LIMITED");
          end if;
 
          Resync_Past_Semicolon;
 
       elsif Token = Tok_Tagged then
-         Error_Msg_SC ("TAGGED must come before LIMITED");
+         Error_Msg_SC -- CODEFIX
+           ("TAGGED must come before LIMITED");
          Resync_Past_Semicolon;
       end if;
 
@@ -817,7 +835,7 @@ package body Ch12 is
    --    [abstract] [limited | synchronized]
    --         new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
 
-   --  The caller has checked the initial token(s) is/are NEW, ASTRACT NEW,
+   --  The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW,
    --  or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT
    --  SYNCHRONIZED NEW.