[Ada] Streamline implementation of Has_Compatible_Representation

The predicate is only concerned with the internal representation of types
and this representation is shared by the subtypes of a given type, so the
implementation can directly look into the (implementation) base types.

No functional changes.

gcc/ada/

	* sem_ch13.ads (Has_Compatible_Representation): Minor tweaks.
	* sem_ch13.adb (Has_Compatible_Representation): Look directly into
	the (implementation) base types and simplifiy accordingly.
	* exp_ch5.adb (Change_Of_Representation): Adjust.
	* exp_ch6.adb (Expand_Actuals): Likewise.
This commit is contained in:
Eric Botcazou 2022-03-20 18:01:04 +01:00 committed by Pierre-Marie de Rodat
parent 87a6558424
commit e2f7d58cda
4 changed files with 31 additions and 49 deletions

View File

@ -292,8 +292,8 @@ package body Exp_Ch5 is
return
Nkind (Rhs) = N_Type_Conversion
and then not Has_Compatible_Representation
(Target_Type => Etype (Rhs),
Operand_Type => Etype (Expression (Rhs)));
(Target_Typ => Etype (Rhs),
Operand_Typ => Etype (Expression (Rhs)));
end Change_Of_Representation;
------------------------------

View File

@ -1576,8 +1576,8 @@ package body Exp_Ch6 is
Var := Make_Var (Expression (Actual));
Crep := not Has_Compatible_Representation
(Target_Type => F_Typ,
Operand_Type => Etype (Expression (Actual)));
(Target_Typ => F_Typ,
Operand_Typ => Etype (Expression (Actual)));
else
V_Typ := Etype (Actual);
@ -2379,8 +2379,8 @@ package body Exp_Ch6 is
-- Also pass by copy if change of representation
or else not Has_Compatible_Representation
(Target_Type => Etype (Formal),
Operand_Type => Etype (Expression (Actual))))
(Target_Typ => Etype (Formal),
Operand_Typ => Etype (Expression (Actual))))
then
Add_Call_By_Copy_Code;
@ -4556,8 +4556,8 @@ package body Exp_Ch6 is
-- warning, and do the change of representation.
elsif not Has_Compatible_Representation
(Target_Type => Formal_Typ,
Operand_Type => Parent_Typ)
(Target_Typ => Formal_Typ,
Operand_Typ => Parent_Typ)
then
Error_Msg_N
("??change of representation required", Actual);

View File

@ -13436,56 +13436,40 @@ package body Sem_Ch13 is
-----------------------------------
function Has_Compatible_Representation
(Target_Type, Operand_Type : Entity_Id) return Boolean
(Target_Typ, Operand_Typ : Entity_Id) return Boolean
is
T1 : constant Entity_Id := Underlying_Type (Target_Type);
T2 : constant Entity_Id := Underlying_Type (Operand_Type);
-- The subtype-specific representation attributes (Size and Alignment)
-- do not affect representation from the point of view of this function.
T1 : constant Entity_Id := Implementation_Base_Type (Target_Typ);
T2 : constant Entity_Id := Implementation_Base_Type (Operand_Typ);
begin
-- A quick check, if base types are the same, then we definitely have
-- the same representation, because the subtype specific representation
-- attributes (Size and Alignment) do not affect representation from
-- the point of view of this test.
-- Return true immediately for the same base type
if Base_Type (T1) = Base_Type (T2) then
if T1 = T2 then
return True;
elsif Is_Private_Type (Base_Type (T2))
and then Base_Type (T1) = Full_View (Base_Type (T2))
then
return True;
-- If T2 is a generic actual it is declared as a subtype, so
-- check against its base type.
elsif Is_Generic_Actual_Type (T1)
and then Has_Compatible_Representation (Base_Type (T1), T2)
then
return True;
end if;
-- Tagged types always have the same representation, because it is not
-- possible to specify different representations for common fields.
if Is_Tagged_Type (T1) then
elsif Is_Tagged_Type (T1) then
return True;
end if;
-- Representations are definitely different if conventions differ
if Convention (T1) /= Convention (T2) then
elsif Convention (T1) /= Convention (T2) then
return False;
end if;
-- Representations are different if component alignments or scalar
-- storage orders differ.
if (Is_Record_Type (T1) or else Is_Array_Type (T1))
and then
(Is_Record_Type (T2) or else Is_Array_Type (T2))
and then
(Component_Alignment (T1) /= Component_Alignment (T2)
or else Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
elsif (Is_Record_Type (T1) or else Is_Array_Type (T1))
and then
(Is_Record_Type (T2) or else Is_Array_Type (T2))
and then (Component_Alignment (T1) /= Component_Alignment (T2)
or else
Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
then
return False;
end if;
@ -13512,11 +13496,10 @@ package body Sem_Ch13 is
then
return True;
end if;
end if;
-- For records, representations are different if reorderings differ
-- For records, representations are different if reordering differs
if Is_Record_Type (T1)
elsif Is_Record_Type (T1)
and then Is_Record_Type (T2)
and then No_Reordering (T1) /= No_Reordering (T2)
then

View File

@ -130,12 +130,11 @@ package Sem_Ch13 is
-- clause, T is the component type.
function Has_Compatible_Representation
(Target_Type, Operand_Type : Entity_Id) return Boolean;
-- Given two types, where the two types are related by possible derivation,
-- determines if the two types have compatible representation, or different
-- representations, requiring the special processing for representation
-- change. A False result is possible only for array, enumeration or
-- record types.
(Target_Typ, Operand_Typ : Entity_Id) return Boolean;
-- Given an explicit or implicit conversion from Operand_Typ to Target_Typ,
-- determine whether the types have compatible or different representation,
-- thus requiring special processing for the conversion in the latter case.
-- A False result is possible only for array, enumeration and record types.
procedure Parse_Aspect_Aggregate
(N : Node_Id;