Patchwork [Ada] Pragma Ada_2012 now allows an argument

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 7, 2010, 9:12 a.m.
Message ID <20101007091247.GA2969@adacore.com>
Download mbox | patch
Permalink /patch/67015/
State New
Headers show

Comments

Arnaud Charlet - Oct. 7, 2010, 9:12 a.m.
This patch implements allowing an argument for pragma Ada_2012,
exactly like the corresponding behavior for Ada_2005. The
following test program:

procedure Ada2012Only is
   R : Integer;
   pragma Ada_2012 (R);
   S : Integer := 3;
begin
   R := S;
end;

compiles clean in Ada_2012 mode, and if compiled in any other mode
generates an appopriate warning:

ada2012only.adb:6:04: warning: "R" is only defined in Ada 2012

Tested on x86_64-pc-linux-gnu, committed on trunk

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

	* 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.

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 165080)
+++ sem_ch3.adb	(working copy)
@@ -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
Index: sem_type.adb
===================================================================
--- sem_type.adb	(revision 165080)
+++ sem_type.adb	(working copy)
@@ -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;
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb	(revision 165080)
+++ sem_ch7.adb	(working copy)
@@ -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
Index: einfo.adb
===================================================================
--- einfo.adb	(revision 165080)
+++ einfo.adb	(working copy)
@@ -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));
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 165080)
+++ einfo.ads	(working copy)
@@ -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);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 165080)
+++ sem_prag.adb	(working copy)
@@ -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 --
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 165080)
+++ par-prag.adb	(working copy)
@@ -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 --
Index: itypes.adb
===================================================================
--- itypes.adb	(revision 165080)
+++ itypes.adb	(working copy)
@@ -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;
Index: sem_warn.adb
===================================================================
--- sem_warn.adb	(revision 165080)
+++ sem_warn.adb	(working copy)
@@ -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;
Index: opt.ads
===================================================================
--- opt.ads	(revision 165080)
+++ opt.ads	(working copy)
@@ -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
Index: lib-xref.adb
===================================================================
--- lib-xref.adb	(revision 165080)
+++ lib-xref.adb	(working copy)
@@ -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