OSDN Git Service

Merge remote-tracking branch 'gnu/gcc-4_7-branch' into rework
[pf3gnuchains/gcc-fork.git] / gcc / ada / par-ch3.adb
index 059b403..bfc4f59 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -210,24 +210,10 @@ package body Ch3 is
       --  we set Force_Msg to True, since we want at least one message for each
       --  separate declaration (but not use) of a reserved identifier.
 
-      if Token = Tok_Identifier then
-
-         --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
-         --  OVERRIDING, and SYNCHRONIZED are new reserved words. Note that
-         --  in the case where these keywords are misused in Ada 95 mode,
-         --  this routine will generally not be called at all.
+      --  Duplication should be removed, common code should be factored???
 
-         if Ada_Version = Ada_95
-           and then Warn_On_Ada_2005_Compatibility
-         then
-            if Token_Name = Name_Overriding
-              or else Token_Name = Name_Synchronized
-              or else (Token_Name = Name_Interface
-                        and then Prev_Token /= Tok_Pragma)
-            then
-               Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
-            end if;
-         end if;
+      if Token = Tok_Identifier then
+         Check_Future_Keyword;
 
       --  If we have a reserved identifier, manufacture an identifier with
       --  a corresponding name after posting an appropriate error message
@@ -647,7 +633,7 @@ package body Ch3 is
                      Error_Msg_SP
                        ("(Ada 83) limited record declaration not allowed!");
 
-                  --  In Ada2005, "abstract limited" can appear before "new",
+                  --  In Ada 2005, "abstract limited" can appear before "new",
                   --  but it cannot be part of an untagged record declaration.
 
                   elsif Abstract_Present
@@ -941,7 +927,8 @@ package body Ch3 is
    --------------------------------
 
    --  SUBTYPE_DECLARATION ::=
-   --    subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION;
+   --    subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION
+   --    {ASPECT_SPECIFICATIONS];
 
    --  The caller has checked that the initial token is SUBTYPE
 
@@ -1073,7 +1060,11 @@ package body Ch3 is
    begin
       Constr_Node := P_Constraint_Opt;
 
-      if No (Constr_Node) then
+      if No (Constr_Node)
+        or else
+          (Nkind (Constr_Node) = N_Range_Constraint
+             and then Nkind (Range_Expression (Constr_Node)) = N_Error)
+      then
          return Subtype_Mark;
       else
          if Not_Null_Present then
@@ -1125,16 +1116,6 @@ package body Ch3 is
          Discard_Junk_Node (P_Array_Type_Definition);
          return Error;
 
-      --  If Some becomes a keyword, the following is needed to make it
-      --  acceptable in older versions of Ada.
-
-      elsif Token = Tok_Some
-        and then Ada_Version < Ada_2012
-      then
-         Scan_Reserved_Identifier (False);
-         Scan;
-         return Token_Node;
-
       else
          Type_Node := P_Qualified_Simple_Name_Resync;
 
@@ -2298,13 +2279,30 @@ package body Ch3 is
          Scan; -- past RANGE
       end if;
 
-      Expr_Node := P_Expression;
-      Check_Simple_Expression (Expr_Node);
-      Set_Low_Bound (Typedef_Node, Expr_Node);
-      T_Dot_Dot;
-      Expr_Node := P_Expression;
-      Check_Simple_Expression (Expr_Node);
-      Set_High_Bound (Typedef_Node, Expr_Node);
+      Expr_Node := P_Expression_Or_Range_Attribute;
+
+      --  Range case (not permitted by the grammar, this is surprising but
+      --  the grammar in the RM is as quoted above, and does not allow Range).
+
+      if Expr_Form = EF_Range_Attr then
+         Error_Msg_N
+           ("Range attribute not allowed here, use First .. Last", Expr_Node);
+         Set_Low_Bound (Typedef_Node, Expr_Node);
+         Set_Attribute_Name (Expr_Node, Name_First);
+         Set_High_Bound (Typedef_Node, Copy_Separate_Tree (Expr_Node));
+         Set_Attribute_Name (High_Bound (Typedef_Node), Name_Last);
+
+      --  Normal case of explicit range
+
+      else
+         Check_Simple_Expression (Expr_Node);
+         Set_Low_Bound (Typedef_Node, Expr_Node);
+         T_Dot_Dot;
+         Expr_Node := P_Expression;
+         Check_Simple_Expression (Expr_Node);
+         Set_High_Bound (Typedef_Node, Expr_Node);
+      end if;
+
       return Typedef_Node;
    end P_Signed_Integer_Type_Definition;
 
@@ -2528,6 +2526,7 @@ package body Ch3 is
    --  Note: this is an obsolescent feature in Ada 95 (I.3)
 
    --  Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
+   --  (also true in formal modes).
 
    --  The caller has checked that the initial token is DELTA
 
@@ -2542,6 +2541,7 @@ package body Ch3 is
       Scan; -- past DELTA
       Expr_Node := P_Expression;
       Check_Simple_Expression_In_Ada_83 (Expr_Node);
+
       Set_Delta_Expression (Constraint_Node, Expr_Node);
 
       if Token = Tok_Range then
@@ -2666,9 +2666,12 @@ package body Ch3 is
             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
          end if;
 
-         if Aliased_Present then
-            Error_Msg_SP ("ALIASED not allowed here");
-         end if;
+         --  AI95-406 makes "aliased" legal (and useless) in this context so
+         --  followintg code which used to be needed is commented out.
+
+         --  if Aliased_Present then
+         --     Error_Msg_SP ("ALIASED not allowed here");
+         --  end if;
 
          Set_Subtype_Indication     (CompDef_Node, Empty);
          Set_Aliased_Present        (CompDef_Node, False);
@@ -2776,11 +2779,17 @@ package body Ch3 is
          Set_High_Bound (Range_Node, Expr_Node);
          return Range_Node;
 
-      --  Otherwise we must have a subtype mark
+      --  Otherwise we must have a subtype mark, or an Ada 2012 iterator
 
       elsif Expr_Form = EF_Simple_Name then
          return Expr_Node;
 
+      --  The domain of iteration must be a name. Semantics will determine that
+      --  the expression has the proper form.
+
+      elsif Ada_Version >= Ada_2012 then
+         return Expr_Node;
+
       --  If incorrect, complain that we expect ..
 
       else
@@ -3435,9 +3444,12 @@ package body Ch3 is
                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
                end if;
 
-               if Aliased_Present then
-                  Error_Msg_SP ("ALIASED not allowed here");
-               end if;
+               --  AI95-406 makes "aliased" legal (and useless) here, so the
+               --  following code which used to be required is commented out.
+
+               --  if Aliased_Present then
+               --     Error_Msg_SP ("ALIASED not allowed here");
+               --  end if;
 
                Set_Subtype_Indication (CompDef_Node, Empty);
                Set_Aliased_Present    (CompDef_Node, False);
@@ -3714,13 +3726,23 @@ package body Ch3 is
          end if;
 
          if Token = Tok_Comma then
-            Error_Msg_SC -- CODEFIX
-              (""","" should be ""'|""");
+            Scan; -- past comma
+
+            if Token = Tok_Vertical_Bar then
+               Error_Msg_SP -- CODEFIX
+                 ("|extra "","" ignored");
+               Scan; -- past |
+
+            else
+               Error_Msg_SP -- CODEFIX
+                 (""","" should be ""'|""");
+            end if;
+
          else
             exit when Token /= Tok_Vertical_Bar;
+            Scan; -- past |
          end if;
 
-         Scan; -- past | or comma
       end loop;
 
       return Choices;
@@ -4207,7 +4229,7 @@ package body Ch3 is
                P_Identifier_Declarations (Decls, Done, In_Spec);
             end if;
 
-         --  Ada2005: A subprogram declaration can start with "not" or
+         --  Ada 2005: A subprogram declaration can start with "not" or
          --  "overriding". In older versions, "overriding" is handled
          --  like an identifier, with the appropriate messages.
 
@@ -4264,8 +4286,42 @@ package body Ch3 is
 
          when Tok_With =>
             Check_Bad_Layout;
-            Error_Msg_SC ("WITH can only appear in context clause");
-            raise Error_Resync;
+
+            if Aspect_Specifications_Present then
+
+               --  If we are after a semicolon, complain that it was ignored.
+               --  But we don't really ignore it, since we dump the aspects,
+               --  so we make the error message a normal fatal message which
+               --  will inhibit semantic analysis anyway).
+
+               if Prev_Token = Tok_Semicolon then
+                  Error_Msg_SP -- CODEFIX
+                    ("extra "";"" ignored");
+
+               --  If not just past semicolon, just complain that aspects are
+               --  not allowed at this point.
+
+               else
+                  Error_Msg_SC ("aspect specifications not allowed here");
+               end if;
+
+               declare
+                  Dummy_Node : constant Node_Id :=
+                                 New_Node (N_Package_Specification, Token_Ptr);
+                  pragma Warnings (Off, Dummy_Node);
+                  --  Dummy node to attach aspect specifications to. We will
+                  --  then throw them away.
+
+               begin
+                  P_Aspect_Specifications (Dummy_Node, Semicolon => True);
+               end;
+
+            --  Here if not aspect specifications case
+
+            else
+               Error_Msg_SC ("WITH can only appear in context clause");
+               raise Error_Resync;
+            end if;
 
          --  BEGIN terminates the scan of a sequence of declarations unless
          --  there is a missing subprogram body, see section on handling