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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/freeze.adb | 3 ++-
gcc/ada/sem_ch13.adb | 9 +++++----
gcc/ada/sem_util.adb | 42 ++++++++++++++++++++++++++++++++++--------
gcc/ada/sem_util.ads | 10 +++++++---
4 files changed, 48 insertions(+), 16 deletions(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ec0fb16e741..ce9a9742274 100644
--- 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 76a8c0ba733..22575f9cbf5 100644
--- 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 02ebb71b562..40e3da36c20 100644
--- 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 29dbae8073e..0e97806f718 100644
--- 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
--
2.43.0
