ada: Emit more warnings on unsupported overlay

In the case where the overlaid object is nested in a record or is an
array element as in:

    for Foo'Address use Item.Nested_Item'Address;
or  for Foo'Address use Item (Bar)'Address;

the compiler was not emitting a warning in case of differing
Scalar_Storage_Order values.

gcc/ada/ChangeLog:

	* sem_util.adb (Find_Overlaid_Entity): Add extra parameter to
	extract the type being overlaid.
	(Note_Possible_Modification): Adjust call to Find_Overlaid_Entity.
	(Ultimate_Overlaid_Entity): Likewise.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Likewise.
	* sem_util.ads (Find_Overlaid_Entity): Add extra parameter to
	extract the type being overlaid.
	* freeze.adb (Check_Address_Clause): Likewise.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ec0fb16e741ee80406f5b68152795ada2320474b..ce9a9742274602bbc8cc5bcf15473312ad47886f 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -715,10 +715,11 @@ package body Freeze is
          then
             declare
                O_Ent : Entity_Id;
+               O_Typ : Entity_Id;
                Off   : Boolean;
 
             begin
-               Find_Overlaid_Entity (Addr, O_Ent, Off);
+               Find_Overlaid_Entity (Addr, O_Ent, O_Typ, Off);
 
                if Ekind (O_Ent) = E_Constant
                  and then Etype (O_Ent) = Typ

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 76a8c0ba7331579f1e8c488815399ebe51497732..22575f9cbf5fe28fafc549ab231ed1db5a8294e4 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6208,6 +6208,7 @@ package body Sem_Ch13 is
                declare
                   Expr  : constant Node_Id := Expression (N);
                   O_Ent : Entity_Id;
+                  O_Typ : Entity_Id;
                   Off   : Boolean;
 
                begin
@@ -6220,7 +6221,7 @@ package body Sem_Ch13 is
                      return;
                   end if;
 
-                  Find_Overlaid_Entity (N, O_Ent, Off);
+                  Find_Overlaid_Entity (N, O_Ent, O_Typ, Off);
 
                   if Present (O_Ent) then
 
@@ -6273,10 +6274,10 @@ package body Sem_Ch13 is
 
                      if (Is_Record_Type (Etype (U_Ent))
                           or else Is_Array_Type (Etype (U_Ent)))
-                       and then (Is_Record_Type (Etype (O_Ent))
-                                  or else Is_Array_Type (Etype (O_Ent)))
+                       and then (Is_Record_Type (O_Typ)
+                                  or else Is_Array_Type (O_Typ))
                        and then Reverse_Storage_Order (Etype (U_Ent)) /=
-                                Reverse_Storage_Order (Etype (O_Ent))
+                                Reverse_Storage_Order (O_Typ)
                      then
                         Error_Msg_N
                           ("??overlay changes scalar storage order", Expr);

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 02ebb71b562c668d9a4bcae0bc23ea806ca39bcf..40e3da36c201f2d66c221ec964fc2349d13d5e5e 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8923,9 +8923,10 @@ package body Sem_Util is
    --------------------------
 
    procedure Find_Overlaid_Entity
-     (N   : Node_Id;
-      Ent : out Entity_Id;
-      Off : out Boolean)
+     (N        : Node_Id;
+      Ent      : out Entity_Id;
+      Ovrl_Typ : out Entity_Id;
+      Off      : out Boolean)
    is
       pragma Assert
         (Nkind (N) = N_Attribute_Definition_Clause
@@ -8948,6 +8949,7 @@ package body Sem_Util is
       --  constant that eventually references Y'Address.
 
       Ent := Empty;
+      Ovrl_Typ := Empty;
       Off := False;
 
       Expr := Expression (N);
@@ -8998,11 +9000,33 @@ package body Sem_Util is
                   and then Is_Concurrent_Type (Scope (Ent)));
                Ent := Empty;
             end if;
+
+            if No (Ovrl_Typ) then
+               Ovrl_Typ := Etype (Ent);
+            end if;
+
             return;
 
          --  Check for components
 
          elsif Nkind (Expr) in N_Selected_Component | N_Indexed_Component then
+            if Nkind (Expr) = N_Selected_Component then
+               --  If Something.Other'Address, use
+               --  the Etype of the Other component.
+
+               if No (Ovrl_Typ) then
+                  Ovrl_Typ := Etype (Entity (Selector_Name (Expr)));
+               end if;
+
+            else
+               --  If Something(Index)'Address, use
+               --  the Etype of the array component.
+
+               if No (Ovrl_Typ) then
+                  Ovrl_Typ := Etype (Expr);
+               end if;
+            end if;
+
             Expr := Prefix (Expr);
             Off  := True;
 
@@ -25599,10 +25623,11 @@ package body Sem_Util is
                declare
                   Addr  : constant Node_Id := Address_Clause (Ent);
                   O_Ent : Entity_Id;
+                  O_Typ : Entity_Id;
                   Off   : Boolean;
 
                begin
-                  Find_Overlaid_Entity (Addr, O_Ent, Off);
+                  Find_Overlaid_Entity (Addr, O_Ent, O_Typ,  Off);
 
                   Error_Msg_Sloc := Sloc (Addr);
                   Error_Msg_NE
@@ -29050,9 +29075,10 @@ package body Sem_Util is
    ------------------------------
 
    function Ultimate_Overlaid_Entity (E : Entity_Id) return Entity_Id is
-      Address : Node_Id;
-      Alias   : Entity_Id := E;
-      Offset  : Boolean;
+      Address  : Node_Id;
+      Alias    : Entity_Id := E;
+      Offset   : Boolean;
+      Ovrl_Typ : Entity_Id;
 
    begin
       --  Currently this routine is only called for stand-alone objects that
@@ -29064,7 +29090,7 @@ package body Sem_Util is
       loop
          Address := Address_Clause (Alias);
          if Present (Address) then
-            Find_Overlaid_Entity (Address, Alias, Offset);
+            Find_Overlaid_Entity (Address, Alias, Ovrl_Typ, Offset);
             if Present (Alias) then
                null;
             else

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 29dbae8073efdaeb0ff4592e19322e63794d8382..0e97806f7186251e647cc7f136e217a146e111a0 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -898,14 +898,18 @@ package Sem_Util is
    --  loop are nested within the block.
 
    procedure Find_Overlaid_Entity
-     (N   : Node_Id;
-      Ent : out Entity_Id;
-      Off : out Boolean);
+     (N        : Node_Id;
+      Ent      : out Entity_Id;
+      Ovrl_Typ : out Entity_Id;
+      Off      : out Boolean);
    --  The node N should be an address representation clause. Determines if the
    --  target expression is the address of an entity with an optional offset.
    --  If so, set Ent to the entity and, if there is an offset, set Off to
    --  True, otherwise to False. If it is not possible to determine that the
    --  address is of this form, then set Ent to Empty.
+   --  Ovrl_Typ is set to the type being overlaid and can be different than the
+   --  type of Ent, for example when the address clause is applied to a record
+   --  component or to an element of an array.
 
    function Find_Parameter_Type (Param : Node_Id) return Entity_Id;
    --  Return the type of formal parameter Param as determined by its