Patchwork [Ada] Support for renamings in aspects Depends and Global

login
register
mail settings
Submitter Arnaud Charlet
Date April 11, 2013, 1:30 p.m.
Message ID <20130411133048.GA27599@adacore.com>
Download mbox | patch
Permalink /patch/235745/
State New
Headers show

Comments

Arnaud Charlet - April 11, 2013, 1:30 p.m.
This patch modifies the analysis of aspects Depends and Global. The machinery
can now process renamings of entire objects. Legal renamings are replaced by
the object they rename.

------------
-- Source --
------------

--  renamings.ads

package Renamings
  with Abstract_State => (Input_State with Volatile, Input)
is
   type Composite_Record is record
      Comp : Integer;
   end record;
   Rec : Composite_Record;
   type Composite_Array is array (1 .. 5) of Composite_Record;
   Arr : Composite_Array;

   --  "entire object" renamings

   Ren_1 : Composite_Record renames Rec;
   Ren_2 : Composite_Record renames Ren_1;

   --  illegal renamings

   Ren_3 : Integer renames Rec.Comp;
   Ren_4 : Composite_Record renames Arr (3);
   Ren_5 : Integer renames Arr (3).Comp;

   procedure OK_1
     with Global => Ren_1;
   procedure OK_2
     with Global => Ren_2;
   procedure Error_1
     with Global => (Rec, Ren_1, Ren_2);
   procedure Error_2
     with Global => (Ren_3, Ren_4, Ren_5);
end Renamings;

--  replacement.ads

package Replacement is
   Obj : Integer;
   Ren : Integer renames Obj;

   procedure OK_1
     with Global => Ren;
   function OK_2 return Integer
     with Depends => (OK_2'Result => Ren);
end Replacement;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c -gnat12 -gnatd.V renamings.ads
$ gcc -c -gnat12 -gnatd.V -gnatdg replacement.ads
renamings.ads:27:27: duplicate global item
renamings.ads:27:34: duplicate global item
renamings.ads:29:22: global item must denote variable or state
renamings.ads:29:29: global item must denote variable or state
renamings.ads:29:36: global item must denote variable or state
Source recreated from tree for Replacement (spec)

replacement_E : short_integer := 0;

package replacement is
   replacement__obj : integer;
   replacement__ren___XR_replacement__obj___XE : _renaming_type;
   replacement__ren : integer renames replacement__obj;
   procedure replacement__ok_1
     with global => ren;
   function replacement__ok_2 return integer
     with depends => (
             replacement__ok_2'result => replacement__obj);
   pragma depends ((
      replacement__ok_2'result => replacement__obj));
   pragma global (replacement__obj);
   freeze replacement__ok_1 []
end replacement;

cannot generate code for file replacement.ads (package spec)

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

2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Both pragma Depends and Global can now
	support renamings of entire objects. Legal renamings are replaced by
	the object they rename.
	(Is_Renaming): New routine.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 197781)
+++ sem_prag.adb	(working copy)
@@ -806,6 +806,9 @@ 
       --  Returns True if pragma appears within the context clause of a unit,
       --  and False for any other placement (does not generate any messages).
 
+      function Is_Renaming (N : Node_Id) return Boolean;
+      --  Determine whether arbitrary node N is a renaming
+
       function Is_Static_String_Expression (Arg : Node_Id) return Boolean;
       --  Analyzes the argument, and determines if it is a static string
       --  expression, returns True if so, False if non-static or not String.
@@ -3013,6 +3016,17 @@ 
          return True;
       end Is_In_Context_Clause;
 
+      -----------------
+      -- Is_Renaming --
+      -----------------
+
+      function Is_Renaming (N : Node_Id) return Boolean is
+      begin
+         return
+           Is_Entity_Name (N)
+             and then Present (Renamed_Object (Entity (N)));
+      end Is_Renaming;
+
       ---------------------------------
       -- Is_Static_String_Expression --
       ---------------------------------
@@ -9017,8 +9031,8 @@ 
                   Null_Seen : in out Boolean)
                is
                   Is_Output : constant Boolean := not Is_Input;
+                  Grouped   : Node_Id;
                   Item_Id   : Entity_Id;
-                  Grouped   : Node_Id;
 
                begin
                   --  Multiple input or output items appear as an aggregate
@@ -9106,15 +9120,19 @@ 
                   else
                      Analyze (Item);
 
-                     if Is_Entity_Name (Item) then
-                        Item_Id := Entity_Of (Item);
+                     --  Find the entity of the item. If this is a renaming,
+                     --  climb the renaming chain to reach the root object.
+                     --  Renamings of non-entire objects do not yield an
+                     --  entity (Empty).
 
-                        if Present (Item_Id)
-                          and then Ekind_In (Item_Id, E_Abstract_State,
-                                                      E_In_Parameter,
-                                                      E_In_Out_Parameter,
-                                                      E_Out_Parameter,
-                                                      E_Variable)
+                     Item_Id := Entity_Of (Item);
+
+                     if Present (Item_Id) then
+                        if Ekind_In (Item_Id, E_Abstract_State,
+                                              E_In_Parameter,
+                                              E_In_Out_Parameter,
+                                              E_Out_Parameter,
+                                              E_Variable)
                         then
                            --  Detect multiple uses of the same state, variable
                            --  or formal parameter. If this is not the case,
@@ -9148,6 +9166,15 @@ 
                               Append_Unique_Elmt (Item_Id, All_Inputs_Seen);
                            end if;
 
+                           --  When the item renames an entire object, replace
+                           --  the item with a reference to the object.
+
+                           if Is_Renaming (Item) then
+                              Rewrite (Item,
+                                New_Reference_To (Item_Id, Sloc (Item)));
+                              Analyze (Item);
+                           end if;
+
                         --  All other input/output items are illegal
 
                         else
@@ -10809,7 +10836,7 @@ 
                  (Item        : Node_Id;
                   Global_Mode : Name_Id)
                is
-                  Id : Entity_Id;
+                  Item_Id : Entity_Id;
 
                begin
                   --  Detect one of the following cases
@@ -10826,13 +10853,18 @@ 
 
                   Analyze (Item);
 
-                  if Is_Entity_Name (Item) then
-                     Id := Entity (Item);
+                  --  Find the entity of the item. If this is a renaming, climb
+                  --  the renaming chain to reach the root object. Renamings of
+                  --  non-entire objects do not yield an entity (Empty).
 
+                  Item_Id := Entity_Of (Item);
+
+                  if Present (Item_Id) then
+
                      --  A global item cannot reference a formal parameter. Do
                      --  this check first to provide a better error diagnostic.
 
-                     if Is_Formal (Id) then
+                     if Is_Formal (Item_Id) then
                         Error_Msg_N
                           ("global item cannot reference formal parameter",
                            Item);
@@ -10841,14 +10873,23 @@ 
                      --  The only legal references are those to abstract states
                      --  and variables.
 
-                     elsif not Ekind_In (Entity (Item), E_Abstract_State,
-                                                        E_Variable)
+                     elsif not Ekind_In (Item_Id, E_Abstract_State,
+                                                  E_Variable)
                      then
                         Error_Msg_N
                           ("global item must denote variable or state", Item);
                         return;
                      end if;
 
+                     --  When the item renames an entire object, replace the
+                     --  item with a reference to the object.
+
+                     if Is_Renaming (Item) then
+                        Rewrite (Item,
+                          New_Reference_To (Item_Id, Sloc (Item)));
+                        Analyze (Item);
+                     end if;
+
                   --  Some form of illegal construct masquerading as a name
 
                   else
@@ -10860,7 +10901,7 @@ 
                   --  The same entity might be referenced through various way.
                   --  Check the entity of the item rather than the item itself.
 
-                  if Contains (Seen, Id) then
+                  if Contains (Seen, Item_Id) then
                      Error_Msg_N ("duplicate global item", Item);
 
                   --  Add the entity of the current item to the list of
@@ -10871,16 +10912,16 @@ 
                         Seen := New_Elmt_List;
                      end if;
 
-                     Append_Elmt (Id, Seen);
+                     Append_Elmt (Item_Id, Seen);
                   end if;
 
-                  if Ekind (Id) = E_Abstract_State
-                    and then Is_Volatile_State (Id)
+                  if Ekind (Item_Id) = E_Abstract_State
+                    and then Is_Volatile_State (Item_Id)
                   then
                      --  A global item of mode In_Out or Output cannot denote a
                      --  volatile Input state.
 
-                     if Is_Input_State (Id)
+                     if Is_Input_State (Item_Id)
                        and then (Global_Mode = Name_In_Out
                                    or else
                                  Global_Mode = Name_Output)
@@ -10892,7 +10933,7 @@ 
                      --  A global item of mode In_Out or Input cannot reference
                      --  a volatile Output state.
 
-                     elsif Is_Output_State (Id)
+                     elsif Is_Output_State (Item_Id)
                        and then (Global_Mode = Name_In_Out
                                    or else
                                  Global_Mode = Name_Input)