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.
Tested on x86_64-pc-linux-gnu, committed on master
diff --git gcc/ada/exp_ch4.adb gcc/ada/exp_ch4.adb
index c35fea3..2f6dc3a 100644
--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -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
diff --git gcc/ada/exp_ch5.adb gcc/ada/exp_ch5.adb
index afd3bca..8482f30 100644
--- gcc/ada/exp_ch5.adb
+++ gcc/ada/exp_ch5.adb
@@ -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;
------------------------------
diff --git gcc/ada/exp_ch6.adb gcc/ada/exp_ch6.adb
index 41ed764..3886493 100644
--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -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);
diff --git gcc/ada/sem_attr.adb gcc/ada/sem_attr.adb
index 78da069..2439169 100644
--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -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.
diff --git gcc/ada/sem_ch13.adb gcc/ada/sem_ch13.adb
index 5ed468e..ec25e3d 100644
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -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 --
----------------------------
diff --git gcc/ada/sem_ch13.ads gcc/ada/sem_ch13.ads
index 43aea2a..3d24c04 100644
--- gcc/ada/sem_ch13.ads
+++ gcc/ada/sem_ch13.ads
@@ -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);
diff --git gcc/ada/sem_res.adb gcc/ada/sem_res.adb
index f1c0177..bf4774c 100644
--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -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.
