OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Ada2020: AI12-0027 Access values and unaliased component

Browse Source 
Access values should never designate unaliased components.
This new feature is documented in AI12-0027-1.

gcc/ada/

	* sem_ch13.ads (Same_Representation): Renamed as
	Has_Compatible_Representation because now the order of the arguments
	are taken into account; its formals are also renamed as Target_Type
	and Operand_Type.
	* sem_ch13.adb (Same_Representation): Renamed and moved to place the
	routine in alphabetic order.
	* sem_attr.adb (Prefix_With_Safe_Accessibility_Level): New subprogram.
	(Resolve_Attribute): Check that the prefix of attribute Access
	does not have a value conversion of an array type.
	* sem_res.adb (Resolve_Actuals): Remove restrictive check on view
	conversions which required matching value of Has_Aliased_Components of
	formals and actuals.
	* exp_ch4.adb (Handle_Changed_Representation): Update call to
	Same_Representation.
	(Expand_N_Type_Conversion): Update call to Same_Representation.
	* exp_ch5.adb (Change_Of_Representation): Update call to
	Same_Representation.
	* exp_ch6.adb (Add_Call_By_Copy_Code): Update call to
	Same_Representation.
	(Expand_Actuals): Update call to Same_Representation.
	(Expand_Call_Helper): Update call to Same_Representation.
This commit is contained in:
Arnaud Charlet 2020-07-23 09:11:56 -04:00
parent de8bfcc8e4
commit 3968b02a4b
7 changed files with 335 additions and 249 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/exp_ch4.adb
View File

@ -11436,7 +11436,7 @@ package body Exp_Ch4 is
begin
-- Nothing else to do if no change of representation
if Same_Representation (Operand_Type, Target_Type) then
if Has_Compatible_Representation (Target_Type, Operand_Type) then
return;
-- The real change of representation work is done by the assignment
@ -12454,7 +12454,7 @@ package body Exp_Ch4 is
-- Special processing is required if there is a change of
-- representation (from enumeration representation clauses).
if not Same_Representation (Target_Type, Operand_Type)
if not Has_Compatible_Representation (Target_Type, Operand_Type)
and then not Conversion_OK (N)
then

5
gcc/ada/exp_ch5.adb
View File

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

16
gcc/ada/exp_ch6.adb
View File

@ -1571,8 +1571,9 @@ package body Exp_Ch6 is
Var := Make_Var (Expression (Actual));
Crep := not Same_Representation
(F_Typ, Etype (Expression (Actual)));
Crep := not Has_Compatible_Representation
(Target_Type => F_Typ,
Operand_Type => Etype (Expression (Actual)));
else
V_Typ := Etype (Actual);
@ -2373,9 +2374,9 @@ package body Exp_Ch6 is
-- Also pass by copy if change of representation
or else not Same_Representation
(Etype (Formal),
Etype (Expression (Actual))))
or else not Has_Compatible_Representation
(Target_Type => Etype (Formal),
Operand_Type => Etype (Expression (Actual))))
then
Add_Call_By_Copy_Code;
@ -4801,7 +4802,10 @@ package body Exp_Ch6 is
-- If there is a change of representation, then generate a
-- warning, and do the change of representation.
elsif not Same_Representation (Formal_Typ, Parent_Typ) then
elsif not Has_Compatible_Representation
(Target_Type => Formal_Typ,
Operand_Type => Parent_Typ)
then
Error_Msg_N
("??change of representation required", Actual);
Convert (Actual, Parent_Typ);

83
gcc/ada/sem_attr.adb
View File

@ -10556,6 +10556,13 @@ package body Sem_Attr is
-- Returns True if Declared_Entity is declared within the declarative
-- region of Generic_Unit; otherwise returns False.
function Prefix_With_Safe_Accessibility_Level return Boolean;
-- Return True if the prefix does not have a value conversion of an
-- array because a value conversion is like an aggregate with respect
-- to determining accessibility level (RM 3.10.2); even if evaluation
-- of a value conversion is guaranteed to not create a new object,
-- accessibility rules are defined as if it might.
---------------------------
-- Accessibility_Message --
---------------------------
@ -10632,6 +10639,73 @@ package body Sem_Attr is
return False;
end Declared_Within_Generic_Unit;
------------------------------------------
-- Prefix_With_Safe_Accessibility_Level --
------------------------------------------
function Prefix_With_Safe_Accessibility_Level return Boolean is
function Safe_Value_Conversions return Boolean;
-- Return False if the prefix has a value conversion of an array type
----------------------------
-- Safe_Value_Conversions --
----------------------------
function Safe_Value_Conversions return Boolean is
PP : Node_Id := P;
begin
loop
if Nkind_In (PP, N_Selected_Component,
N_Indexed_Component)
then
PP := Prefix (PP);
elsif Comes_From_Source (PP)
and then Nkind_In (PP, N_Type_Conversion,
N_Unchecked_Type_Conversion)
and then Is_Array_Type (Etype (PP))
then
return False;
elsif Comes_From_Source (PP)
and then Nkind (PP) = N_Qualified_Expression
and then Is_Array_Type (Etype (PP))
and then Nkind_In (Original_Node (Expression (PP)),
N_Aggregate,
N_Extension_Aggregate)
then
return False;
else
exit;
end if;
end loop;
return True;
end Safe_Value_Conversions;
-- Start of processing for Prefix_With_Safe_Accessibility_Level
begin
-- No check required for unchecked and unrestricted access
if Attr_Id = Attribute_Unchecked_Access
or else Attr_Id = Attribute_Unrestricted_Access
then
return True;
-- Check value conversions
elsif Ekind (Btyp) = E_General_Access_Type
and then not Safe_Value_Conversions
then
return False;
end if;
return True;
end Prefix_With_Safe_Accessibility_Level;
-- Start of processing for Resolve_Attribute
begin
@ -11473,6 +11547,15 @@ package body Sem_Attr is
end if;
end if;
-- Check that the prefix does not have a value conversion of an
-- array type since a value conversion is like an aggregate with
-- respect to determining accessibility level (RM 3.10.2).
if not Prefix_With_Safe_Accessibility_Level then
Accessibility_Message;
return;
end if;
-- Mark that address of entity is taken in case of
-- 'Unrestricted_Access or in case of a subprogram.

443
gcc/ada/sem_ch13.adb
View File

@ -12792,6 +12792,234 @@ package body Sem_Ch13 is
end if;
end Get_Alignment_Value;
-----------------------------------
-- Has_Compatible_Representation --
-----------------------------------
function Has_Compatible_Representation
(Target_Type, Operand_Type : Entity_Id) return Boolean
is
T1 : constant Entity_Id := Underlying_Type (Target_Type);
T2 : constant Entity_Id := Underlying_Type (Operand_Type);
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.
if Base_Type (T1) = Base_Type (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
return True;
end if;
-- Representations are definitely different if conventions differ
if 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))
then
return False;
end if;
-- For arrays, the only real issue is component size. If we know the
-- component size for both arrays, and it is the same, then that's
-- good enough to know we don't have a change of representation.
if Is_Array_Type (T1) then
-- In a view conversion, if the target type is an array type having
-- aliased components and the operand type is an array type having
-- unaliased components, then a new object is created (4.6(58.3/4)).
if Has_Aliased_Components (T1)
and then not Has_Aliased_Components (T2)
then
return False;
end if;
if Known_Component_Size (T1)
and then Known_Component_Size (T2)
and then Component_Size (T1) = Component_Size (T2)
then
return True;
end if;
end if;
-- For records, representations are different if reorderings differ
if Is_Record_Type (T1)
and then Is_Record_Type (T2)
and then No_Reordering (T1) /= No_Reordering (T2)
then
return False;
end if;
-- Types definitely have same representation if neither has non-standard
-- representation since default representations are always consistent.
-- If only one has non-standard representation, and the other does not,
-- then we consider that they do not have the same representation. They
-- might, but there is no way of telling early enough.
if Has_Non_Standard_Rep (T1) then
if not Has_Non_Standard_Rep (T2) then
return False;
end if;
else
return not Has_Non_Standard_Rep (T2);
end if;
-- Here the two types both have non-standard representation, and we need
-- to determine if they have the same non-standard representation.
-- For arrays, we simply need to test if the component sizes are the
-- same. Pragma Pack is reflected in modified component sizes, so this
-- check also deals with pragma Pack.
if Is_Array_Type (T1) then
return Component_Size (T1) = Component_Size (T2);
-- Case of record types
elsif Is_Record_Type (T1) then
-- Packed status must conform
if Is_Packed (T1) /= Is_Packed (T2) then
return False;
-- Otherwise we must check components. Typ2 maybe a constrained
-- subtype with fewer components, so we compare the components
-- of the base types.
else
Record_Case : declare
CD1, CD2 : Entity_Id;
function Same_Rep return Boolean;
-- CD1 and CD2 are either components or discriminants. This
-- function tests whether they have the same representation.
--------------
-- Same_Rep --
--------------
function Same_Rep return Boolean is
begin
if No (Component_Clause (CD1)) then
return No (Component_Clause (CD2));
else
-- Note: at this point, component clauses have been
-- normalized to the default bit order, so that the
-- comparison of Component_Bit_Offsets is meaningful.
return
Present (Component_Clause (CD2))
and then
Component_Bit_Offset (CD1) = Component_Bit_Offset (CD2)
and then
Esize (CD1) = Esize (CD2);
end if;
end Same_Rep;
-- Start of processing for Record_Case
begin
if Has_Discriminants (T1) then
-- The number of discriminants may be different if the
-- derived type has fewer (constrained by values). The
-- invisible discriminants retain the representation of
-- the original, so the discrepancy does not per se
-- indicate a different representation.
CD1 := First_Discriminant (T1);
CD2 := First_Discriminant (T2);
while Present (CD1) and then Present (CD2) loop
if not Same_Rep then
return False;
else
Next_Discriminant (CD1);
Next_Discriminant (CD2);
end if;
end loop;
end if;
CD1 := First_Component (Underlying_Type (Base_Type (T1)));
CD2 := First_Component (Underlying_Type (Base_Type (T2)));
while Present (CD1) loop
if not Same_Rep then
return False;
else
Next_Component (CD1);
Next_Component (CD2);
end if;
end loop;
return True;
end Record_Case;
end if;
-- For enumeration types, we must check each literal to see if the
-- representation is the same. Note that we do not permit enumeration
-- representation clauses for Character and Wide_Character, so these
-- cases were already dealt with.
elsif Is_Enumeration_Type (T1) then
Enumeration_Case : declare
L1, L2 : Entity_Id;
begin
L1 := First_Literal (T1);
L2 := First_Literal (T2);
while Present (L1) loop
if Enumeration_Rep (L1) /= Enumeration_Rep (L2) then
return False;
else
Next_Literal (L1);
Next_Literal (L2);
end if;
end loop;
return True;
end Enumeration_Case;
-- Any other types have the same representation for these purposes
else
return True;
end if;
end Has_Compatible_Representation;
-------------------------------------
-- Inherit_Aspects_At_Freeze_Point --
-------------------------------------
@ -14657,221 +14885,6 @@ package body Sem_Ch13 is
end loop;
end Resolve_Aspect_Expressions;
-------------------------
-- Same_Representation --
-------------------------
function Same_Representation (Typ1, Typ2 : Entity_Id) return Boolean is
T1 : constant Entity_Id := Underlying_Type (Typ1);
T2 : constant Entity_Id := Underlying_Type (Typ2);
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.
if Base_Type (T1) = Base_Type (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 Same_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
return True;
end if;
-- Representations are definitely different if conventions differ
if 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))
then
return False;
end if;
-- For arrays, the only real issue is component size. If we know the
-- component size for both arrays, and it is the same, then that's
-- good enough to know we don't have a change of representation.
if Is_Array_Type (T1) then
if Known_Component_Size (T1)
and then Known_Component_Size (T2)
and then Component_Size (T1) = Component_Size (T2)
then
return True;
end if;
end if;
-- For records, representations are different if reorderings differ
if Is_Record_Type (T1)
and then Is_Record_Type (T2)
and then No_Reordering (T1) /= No_Reordering (T2)
then
return False;
end if;
-- Types definitely have same representation if neither has non-standard
-- representation since default representations are always consistent.
-- If only one has non-standard representation, and the other does not,
-- then we consider that they do not have the same representation. They
-- might, but there is no way of telling early enough.
if Has_Non_Standard_Rep (T1) then
if not Has_Non_Standard_Rep (T2) then
return False;
end if;
else
return not Has_Non_Standard_Rep (T2);
end if;
-- Here the two types both have non-standard representation, and we need
-- to determine if they have the same non-standard representation.
-- For arrays, we simply need to test if the component sizes are the
-- same. Pragma Pack is reflected in modified component sizes, so this
-- check also deals with pragma Pack.
if Is_Array_Type (T1) then
return Component_Size (T1) = Component_Size (T2);
-- Case of record types
elsif Is_Record_Type (T1) then
-- Packed status must conform
if Is_Packed (T1) /= Is_Packed (T2) then
return False;
-- Otherwise we must check components. Typ2 maybe a constrained
-- subtype with fewer components, so we compare the components
-- of the base types.
else
Record_Case : declare
CD1, CD2 : Entity_Id;
function Same_Rep return Boolean;
-- CD1 and CD2 are either components or discriminants. This
-- function tests whether they have the same representation.
--------------
-- Same_Rep --
--------------
function Same_Rep return Boolean is
begin
if No (Component_Clause (CD1)) then
return No (Component_Clause (CD2));
else
-- Note: at this point, component clauses have been
-- normalized to the default bit order, so that the
-- comparison of Component_Bit_Offsets is meaningful.
return
Present (Component_Clause (CD2))
and then
Component_Bit_Offset (CD1) = Component_Bit_Offset (CD2)
and then
Esize (CD1) = Esize (CD2);
end if;
end Same_Rep;
-- Start of processing for Record_Case
begin
if Has_Discriminants (T1) then
-- The number of discriminants may be different if the
-- derived type has fewer (constrained by values). The
-- invisible discriminants retain the representation of
-- the original, so the discrepancy does not per se
-- indicate a different representation.
CD1 := First_Discriminant (T1);
CD2 := First_Discriminant (T2);
while Present (CD1) and then Present (CD2) loop
if not Same_Rep then
return False;
else
Next_Discriminant (CD1);
Next_Discriminant (CD2);
end if;
end loop;
end if;
CD1 := First_Component (Underlying_Type (Base_Type (T1)));
CD2 := First_Component (Underlying_Type (Base_Type (T2)));
while Present (CD1) loop
if not Same_Rep then
return False;
else
Next_Component (CD1);
Next_Component (CD2);
end if;
end loop;
return True;
end Record_Case;
end if;
-- For enumeration types, we must check each literal to see if the
-- representation is the same. Note that we do not permit enumeration
-- representation clauses for Character and Wide_Character, so these
-- cases were already dealt with.
elsif Is_Enumeration_Type (T1) then
Enumeration_Case : declare
L1, L2 : Entity_Id;
begin
L1 := First_Literal (T1);
L2 := First_Literal (T2);
while Present (L1) loop
if Enumeration_Rep (L1) /= Enumeration_Rep (L2) then
return False;
else
Next_Literal (L1);
Next_Literal (L2);
end if;
end loop;
return True;
end Enumeration_Case;
-- Any other types have the same representation for these purposes
else
return True;
end if;
end Same_Representation;
----------------------------
-- Parse_Aspect_Aggregate --
----------------------------

15
gcc/ada/sem_ch13.ads
View File

@ -128,6 +128,14 @@ package Sem_Ch13 is
-- If the size is too small, and an error message is given, then both
-- Esize and RM_Size are reset to the allowed minimum value in T.
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.
procedure Parse_Aspect_Aggregate
(N : Node_Id;
Empty_Subp : in out Node_Id;
@ -196,13 +204,6 @@ package Sem_Ch13 is
-- because such clauses are linked on to the Rep_Item chain in procedure
-- Sem_Ch13.Analyze_Aspect_Specifications. See that procedure for details.
function Same_Representation (Typ1, Typ2 : Entity_Id) return Boolean;
-- Given two types, where the two types are related by possible derivation,
-- determines if the two types have the same representation, or different
-- representations, requiring the special processing for representation
-- change. A False result is possible only for array, enumeration or
-- record types.
procedure Validate_Unchecked_Conversion
(N : Node_Id;
Act_Unit : Entity_Id);

18
gcc/ada/sem_res.adb
View File

@ -4118,25 +4118,9 @@ package body Sem_Res is
if Ekind (F) = E_In_Out_Parameter
and then Is_Array_Type (Etype (F))
then
-- In a view conversion, the conversion must be legal in
-- both directions, and thus both component types must be
-- aliased, or neither (4.6 (8)).
-- The extra rule in 4.6 (24.9.2) seems unduly
-- restrictive: the privacy requirement should not apply
-- to generic types, and should be checked in an
-- instance. ARG query is in order ???
if Has_Aliased_Components (Expr_Typ) /=
Has_Aliased_Components (Etype (F))
then
Error_Msg_N
("both component types in a view conversion must be"
& " aliased, or neither", A);
-- Comment here??? what set of cases???
elsif not Same_Ancestor (Etype (F), Expr_Typ) then
if not Same_Ancestor (Etype (F), Expr_Typ) then
-- Check view conv between unrelated by ref array
-- types.