[multiple changes]

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Minor reformatting.
	* einfo.ads, einfo.adb (Is_Ada_2012_Only): New flag
	* itypes.adb (Create_Null_Excluding_Itype): Set Is_Ada_2012_Only flag
	properly.
	* lib-xref.adb (Generate_Reference): Warn on use of Ada 2012 entity in
	non-Ada 2012 mode.
	* opt.ads (Warn_On_Ada_2012_Compatibility): New flag
	* sem_ch3.adb (Analye_Subtype_Declaration): Inherit Is_Ada_2012_Only
	* sem_ch7.adb (Preserve_Full_Attributes): Preserve Is_Ada_2012_Only
	flag.
	* sem_prag.adb (Analyze_Pragma, case Ada_12/Ada_2012): Allow form with
	argument.
	* sem_type.adb (Disambiguate): Deal with Is_Ada_2012_Only.
	* sem_warn.adb (Warn_On_Ada_2012_Compatibility): New flag, treated
	same as 2005 flag.

2010-10-07  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads: Use new support for pragma Ada_2012 with function
	Type_Is_Abstract.

From-SVN: r165082

14 files changed, 137 insertions, 27 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cf3c16d..c774342 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
+	* sem_attr.adb: Minor reformatting.
+	* einfo.ads, einfo.adb (Is_Ada_2012_Only): New flag
+	* itypes.adb (Create_Null_Excluding_Itype): Set Is_Ada_2012_Only flag
+	properly.
+	* lib-xref.adb (Generate_Reference): Warn on use of Ada 2012 entity in
+	non-Ada 2012 mode.
+	* opt.ads (Warn_On_Ada_2012_Compatibility): New flag
+	* sem_ch3.adb (Analye_Subtype_Declaration): Inherit Is_Ada_2012_Only
+	* sem_ch7.adb (Preserve_Full_Attributes): Preserve Is_Ada_2012_Only
+	flag.
+	* sem_prag.adb (Analyze_Pragma, case Ada_12/Ada_2012): Allow form with
+	argument.
+	* sem_type.adb (Disambiguate): Deal with Is_Ada_2012_Only.
+	* sem_warn.adb (Warn_On_Ada_2012_Compatibility): New flag, treated
+	same as 2005 flag.
+
+2010-10-07  Javier Miranda  <miranda@adacore.com>
+
+	* a-tags.ads: Use new support for pragma Ada_2012 with function
+	Type_Is_Abstract.
+
 2010-10-07  Ed Schonberg  <schonberg@adacore.com>
 
 	* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads
index e03d58d..69ebedc 100644
--- a/gcc/ada/a-tags.ads
+++ b/gcc/ada/a-tags.ads
@@ -76,7 +76,7 @@ package Ada.Tags is
    pragma Ada_05 (Interface_Ancestor_Tags);
 
    function Type_Is_Abstract (T : Tag) return Boolean;
-   pragma Ada_05 (Type_Is_Abstract);
+   pragma Ada_2012 (Type_Is_Abstract);
 
    Tag_Error : exception;
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 0793a60..6fe87a7 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -457,6 +457,7 @@ package body Einfo is
    --    Was_Hidden                      Flag196
    --    Is_Limited_Interface            Flag197
    --    Has_Pragma_Ordered              Flag198
+   --    Is_Ada_2012_Only                Flag199
 
    --    Has_Anon_Block_Suffix           Flag201
    --    Itype_Printed                   Flag202
@@ -510,7 +511,6 @@ package body Einfo is
    --    Is_Underlying_Record_View       Flag246
    --    OK_To_Rename                    Flag247
 
-   --    (unused)                        Flag199
    --    (unused)                        Flag200
 
    -----------------------
@@ -1609,6 +1609,11 @@ package body Einfo is
       return Flag185 (Id);
    end Is_Ada_2005_Only;
 
+   function Is_Ada_2012_Only (Id : E) return B is
+   begin
+      return Flag199 (Id);
+   end Is_Ada_2012_Only;
+
    function Is_Aliased (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -4029,6 +4034,11 @@ package body Einfo is
       Set_Flag185 (Id, V);
    end Set_Is_Ada_2005_Only;
 
+   procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
+   begin
+      Set_Flag199 (Id, V);
+   end Set_Is_Ada_2012_Only;
+
    procedure Set_Is_Aliased (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -6958,6 +6968,7 @@ package body Einfo is
       W ("Is_Local_Anonymous_Access",       Flag194 (Id));
       W ("Is_Access_Constant",              Flag69  (Id));
       W ("Is_Ada_2005_Only",                Flag185 (Id));
+      W ("Is_Ada_2012_Only",                Flag199 (Id));
       W ("Is_Aliased",                      Flag15  (Id));
       W ("Is_Asynchronous",                 Flag81  (Id));
       W ("Is_Atomic",                       Flag85  (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7a396c7..ed91d5e 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1889,10 +1889,18 @@ package Einfo is
 --       Applies to all entities, true for access types and subtypes
 
 --    Is_Ada_2005_Only (Flag185)
---       Present in all entities, true if a valid pragma Ada_05 applies to the
---       entity which specifically names the entity, indicating that the entity
---       is Ada 2005 only. Note that this flag is not set if the entity is part
---       of a unit compiled with the normal no-argument form of pragma Ada_05.
+--       Present in all entities, true if a valid pragma Ada_05 or Ada_2005
+--       applies to the entity which specifically names the entity, indicating
+--       that the entity is Ada 2005 only. Note that this flag is not set if
+--       the entity is part of a unit compiled with the normal no-argument form
+--       of pragma Ada_05 or Ada_2005.
+
+--    Is_Ada_2012_Only (Flag199)
+--       Present in all entities, true if a valid pragma Ada_12 or Ada_2012
+--       applies to the entity which specifically names the entity, indicating
+--       that the entity is Ada 2012 only. Note that this flag is not set if
+--       the entity is part of a unit compiled with the normal no-argument form
+--       of pragma Ada_12 or Ada_2012.
 
 --    Is_Aliased (Flag15)
 --       Present in objects whose declarations carry the keyword aliased,
@@ -4589,6 +4597,7 @@ package Einfo is
    --    Has_Xref_Entry                      (Flag182)
    --    In_Private_Part                     (Flag45)
    --    Is_Ada_2005_Only                    (Flag185)
+   --    Is_Ada_2012_Only                    (Flag199)
    --    Is_Bit_Packed_Array                 (Flag122)  (base type only)
    --    Is_Character_Type                   (Flag63)
    --    Is_Child_Unit                       (Flag73)
@@ -5932,6 +5941,7 @@ package Einfo is
    function Is_Abstract_Type                    (Id : E) return B;
    function Is_Access_Constant                  (Id : E) return B;
    function Is_Ada_2005_Only                    (Id : E) return B;
+   function Is_Ada_2012_Only                    (Id : E) return B;
    function Is_Aliased                          (Id : E) return B;
    function Is_Asynchronous                     (Id : E) return B;
    function Is_Atomic                           (Id : E) return B;
@@ -6493,6 +6503,7 @@ package Einfo is
    procedure Set_Is_Abstract_Type                (Id : E; V : B := True);
    procedure Set_Is_Access_Constant              (Id : E; V : B := True);
    procedure Set_Is_Ada_2005_Only                (Id : E; V : B := True);
+   procedure Set_Is_Ada_2012_Only                (Id : E; V : B := True);
    procedure Set_Is_Aliased                      (Id : E; V : B := True);
    procedure Set_Is_Asynchronous                 (Id : E; V : B := True);
    procedure Set_Is_Atomic                       (Id : E; V : B := True);
@@ -7152,6 +7163,7 @@ package Einfo is
    pragma Inline (Is_Abstract_Type);
    pragma Inline (Is_Access_Constant);
    pragma Inline (Is_Ada_2005_Only);
+   pragma Inline (Is_Ada_2012_Only);
    pragma Inline (Is_Access_Type);
    pragma Inline (Is_Access_Protected_Subprogram_Type);
    pragma Inline (Is_Access_Subprogram_Type);
@@ -7584,6 +7596,7 @@ package Einfo is
    pragma Inline (Set_Is_Abstract_Type);
    pragma Inline (Set_Is_Access_Constant);
    pragma Inline (Set_Is_Ada_2005_Only);
+   pragma Inline (Set_Is_Ada_2012_Only);
    pragma Inline (Set_Is_Aliased);
    pragma Inline (Set_Is_Asynchronous);
    pragma Inline (Set_Is_Atomic);
diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb
index 1c43032..e9a86b4 100644
--- a/gcc/ada/itypes.adb
+++ b/gcc/ada/itypes.adb
@@ -112,6 +112,7 @@ package body Itypes is
       Set_Treat_As_Volatile        (I_Typ, Treat_As_Volatile  (T));
       Set_Is_Atomic                (I_Typ, Is_Atomic          (T));
       Set_Is_Ada_2005_Only         (I_Typ, Is_Ada_2005_Only   (T));
+      Set_Is_Ada_2012_Only         (I_Typ, Is_Ada_2012_Only   (T));
       Set_Can_Never_Be_Null        (I_Typ);
 
       return I_Typ;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 5283023..f149b2e 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -475,6 +475,18 @@ package body Lib.Xref is
          Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
       end if;
 
+      --  Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only
+      --  detect real explicit references (modifications and references).
+
+      if Comes_From_Source (N)
+        and then Is_Ada_2012_Only (E)
+        and then Ada_Version < Ada_12
+        and then Warn_On_Ada_2012_Compatibility
+        and then (Typ = 'm' or else Typ = 'r')
+      then
+         Error_Msg_NE ("& is only defined in Ada 2012?", N, E);
+      end if;
+
       --  Never collect references if not in main source unit. However, we omit
       --  this test if Typ is 'e' or 'k', since these entries are structural,
       --  and it is useful to have them in units that reference packages as
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 59658c6..eae72e0 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1332,6 +1332,12 @@ package Opt is
    --  including warnings on Ada 2005 obsolescent features used in Ada 2005
    --  mode. Set False by -gnatwY.
 
+   Warn_On_Ada_2012_Compatibility : Boolean := True;
+   --  GNAT
+   --  Set to True to generate all warnings on Ada 2012 compatibility issues,
+   --  including warnings on Ada 2012 obsolescent features used in Ada 2012
+   --  mode. Set False by -gnatwY.
+
    Warn_On_Parameter_Order : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings for cases where the argument list for
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index f025916..e6c34e4 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -323,11 +323,14 @@ begin
 
       --  These pragmas must be processed at parse time, since we want to set
       --  the Ada version properly at parse time to recognize the appropriate
-      --  Ada version syntax.
+      --  Ada version syntax. However, it is only the zero argument form that
+      --  must be processed at parse time.
 
       when Pragma_Ada_12 | Pragma_Ada_2012 =>
-         Ada_Version := Ada_12;
-         Ada_Version_Explicit := Ada_12;
+         if Arg_Count = 0 then
+            Ada_Version := Ada_12;
+            Ada_Version_Explicit := Ada_12;
+         end if;
 
       -----------
       -- Debug --
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index babdfde..eae4df2 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7917,6 +7917,7 @@ package body Sem_Attr is
                   --  that generic unit. This includes any such attribute that
                   --  occurs within the body of a generic unit that is a child
                   --  of the generic unit where the subprogram is declared.
+
                   --  The rule also prohibits applying the attribute when the
                   --  access type is a generic formal access type (since the
                   --  level of the actual type is not known). This restriction
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2192fcd..6b008ae 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3466,6 +3466,7 @@ package body Sem_Ch3 is
       Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
       Set_Is_Atomic         (Id, Is_Atomic         (T));
       Set_Is_Ada_2005_Only  (Id, Is_Ada_2005_Only  (T));
+      Set_Is_Ada_2012_Only  (Id, Is_Ada_2012_Only  (T));
       Set_Convention        (Id, Convention        (T));
 
       --  In the case where there is no constraint given in the subtype
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index bd0d130..d0e67be 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2035,6 +2035,7 @@ package body Sem_Ch7 is
          Set_Is_Volatile             (Priv, Is_Volatile                (Full));
          Set_Treat_As_Volatile       (Priv, Treat_As_Volatile          (Full));
          Set_Is_Ada_2005_Only        (Priv, Is_Ada_2005_Only           (Full));
+         Set_Is_Ada_2012_Only        (Priv, Is_Ada_2012_Only           (Full));
          Set_Has_Pragma_Unmodified   (Priv, Has_Pragma_Unmodified      (Full));
          Set_Has_Pragma_Unreferenced (Priv, Has_Pragma_Unreferenced    (Full));
          Set_Has_Pragma_Unreferenced_Objects
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index fa8cff8..409293a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5344,7 +5344,7 @@ package body Sem_Prag is
          --  pragma Ada_2005;
          --  pragma Ada_2005 (LOCAL_NAME):
 
-         --  Note: these pragma also have some specific processing in Par.Prag
+         --  Note: these pragmas also have some specific processing in Par.Prag
          --  because we want to set the Ada 2005 version mode during parsing.
 
          when Pragma_Ada_05 | Pragma_Ada_2005 => declare
@@ -5386,27 +5386,48 @@ package body Sem_Prag is
          ---------------------
 
          --  pragma Ada_12;
+         --  pragma Ada_12 (LOCAL_NAME);
+
          --  pragma Ada_2012;
+         --  pragma Ada_2012 (LOCAL_NAME):
 
-         --  Note: these pragma also have some specific processing in Par.Prag
+         --  Note: these pragmas also have some specific processing in Par.Prag
          --  because we want to set the Ada 2012 version mode during parsing.
 
-         when Pragma_Ada_12 | Pragma_Ada_2012 =>
+         when Pragma_Ada_12 | Pragma_Ada_2012 => declare
+            E_Id : Node_Id;
+
+         begin
             GNAT_Pragma;
-            Check_Arg_Count (0);
 
-            --  For Ada_2012 we unconditionally enforce the documented
-            --  configuration pragma placement, since we do not want to
-            --  tolerate mixed modes in a unit involving Ada 2012. That would
-            --  cause real difficulties for those cases where there are
-            --  incompatibilities between Ada 95 and Ada 2005/Ada 2012.
+            if Arg_Count = 1 then
+               Check_Arg_Is_Local_Name (Arg1);
+               E_Id := Expression (Arg1);
 
-            Check_Valid_Configuration_Pragma;
+               if Etype (E_Id) = Any_Type then
+                  return;
+               end if;
 
-            --  Now set Ada 2012 mode
+               Set_Is_Ada_2012_Only (Entity (E_Id));
 
-            Ada_Version := Ada_12;
-            Ada_Version_Explicit := Ada_12;
+            else
+               Check_Arg_Count (0);
+
+               --  For Ada_2012 we unconditionally enforce the documented
+               --  configuration pragma placement, since we do not want to
+               --  tolerate mixed modes in a unit involving Ada 2012. That
+               --  would cause real difficulties for those cases where there
+               --  are incompatibilities between Ada 95 and Ada 2012. We could
+               --  allow mixing of Ada 2005 and Ada 2012 but it's not worth it.
+
+               Check_Valid_Configuration_Pragma;
+
+               --  Now set Ada 2012 mode
+
+               Ada_Version := Ada_12;
+               Ada_Version_Explicit := Ada_12;
+            end if;
+         end;
 
          ----------------------
          -- All_Calls_Remote --
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index ed6c252..b27f446 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -1533,15 +1533,26 @@ package body Sem_Type is
       It2  := It;
       Nam2 := It.Nam;
 
+      --  Check whether one of the entities is an Ada 2005/2012 and we are
+      --  operating in an earlier mode, in which case we discard the Ada
+      --  2005/2012 entity, so that we get proper Ada 95 overload resolution.
+
       if Ada_Version < Ada_05 then
+         if Is_Ada_2005_Only (Nam1) or else Is_Ada_2012_Only (Nam1) then
+            return It2;
+         elsif Is_Ada_2005_Only (Nam2) or else Is_Ada_2012_Only (Nam1) then
+            return It1;
+         end if;
+      end if;
 
-         --  Check whether one of the entities is an Ada 2005 entity and we are
-         --  operating in an earlier mode, in which case we discard the Ada
-         --  2005 entity, so that we get proper Ada 95 overload resolution.
+      --  Check whether one of the entities is an Ada 2012 entity and we are
+      --  operating in Ada 2005 mode, in which case we discard the Ada 2012
+      --  entity, so that we get proper Ada 2005 overload resolution.
 
-         if Is_Ada_2005_Only (Nam1) then
+      if Ada_Version = Ada_05 then
+         if Is_Ada_2012_Only (Nam1) then
             return It2;
-         elsif Is_Ada_2005_Only (Nam2) then
+         elsif Is_Ada_2012_Only (Nam2) then
             return It1;
          end if;
       end if;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index d4a7145..f6f204e 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3069,6 +3069,7 @@ package body Sem_Warn is
             Implementation_Unit_Warnings        := True;
             Ineffective_Inline_Warnings         := True;
             Warn_On_Ada_2005_Compatibility      := True;
+            Warn_On_Ada_2012_Compatibility      := True;
             Warn_On_All_Unread_Out_Parameters   := True;
             Warn_On_Assertion_Failure           := True;
             Warn_On_Assumed_Low_Bound           := True;
@@ -3189,6 +3190,7 @@ package body Sem_Warn is
       Implementation_Unit_Warnings        := False;
       Ineffective_Inline_Warnings         := True;
       Warn_On_Ada_2005_Compatibility      := True;
+      Warn_On_Ada_2012_Compatibility      := True;
       Warn_On_All_Unread_Out_Parameters   := False;
       Warn_On_Assertion_Failure           := True;
       Warn_On_Assumed_Low_Bound           := True;
@@ -3230,6 +3232,7 @@ package body Sem_Warn is
             Implementation_Unit_Warnings        := True;
             Ineffective_Inline_Warnings         := True;
             Warn_On_Ada_2005_Compatibility      := True;
+            Warn_On_Ada_2012_Compatibility      := True;
             Warn_On_Assertion_Failure           := True;
             Warn_On_Assumed_Low_Bound           := True;
             Warn_On_Bad_Fixed_Value             := True;
@@ -3259,6 +3262,7 @@ package body Sem_Warn is
             Implementation_Unit_Warnings        := False;
             Ineffective_Inline_Warnings         := False;
             Warn_On_Ada_2005_Compatibility      := False;
+            Warn_On_Ada_2012_Compatibility      := False;
             Warn_On_All_Unread_Out_Parameters   := False;
             Warn_On_Assertion_Failure           := False;
             Warn_On_Assumed_Low_Bound           := False;
@@ -3424,9 +3428,11 @@ package body Sem_Warn is
 
          when 'y' =>
             Warn_On_Ada_2005_Compatibility      := True;
+            Warn_On_Ada_2012_Compatibility      := True;
 
          when 'Y' =>
             Warn_On_Ada_2005_Compatibility      := False;
+            Warn_On_Ada_2012_Compatibility      := False;
 
          when 'z' =>
             Warn_On_Unchecked_Conversion        := True;