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

[Ada] AI12-0001: Independence and Representation clauses for atomic objects

Browse Source 
2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
	validate_size.
	(gnat_to_gnu_component_type): Likewise.
	(gnat_to_gnu_field): Likewise and pass string for error messages.
	(components_need_strict_alignment): Remove test on Is_Aliased and
	add test for the independence of the component.
	(validate_size): Add S1 and S2 string parameters and use them to
	give better error messages for fields.  Tweak a couple of messages.
	* einfo.ads (Has_Independent_Components): Document more cases.
	(Is_Independent): Likewise.
	(Strict_Alignment): Document new semantics.
	* exp_ch9.adb (Install_Private_Data_Declarations): Also set the
	Is_Independent flag along with Is_Aliased on the renaming
	entity.
	* freeze.adb (Size_Known): Remove always-false test and add test
	for the strict-alignment on the record type.  Remove redundant
	tests and add test for the strict-alignment on the component
	type.
	(Check_Strict_Alignment): Set the flag if the type is by-ref and
	remove now redundant conditions.  Set the flag on an array type
	if it has aliased components.  In the record type case, do not
	set type for C_Pass_By_Copy convention.
	(Freeze_Array_Type): Move code checking for conflicts between
	representation aspects and clauses to before specific handling
	of packed array types. Give a warnind instead of an error for a
	conflict with pragma Pack.  Do not test Has_Pragma_Pack for the
	specific handling of packed array types.
	(Freeze_Record_Type): Move error checking of representation
	clause to...
	(Freeze_Entity): ...here after Check_Strict_Alignment is called.
	* sem_aggr.adb (Array_Aggr_Subtype): Also set the Is_Independent
	flag along with Is_Aliased on the Itype.
	* sem_ch13.adb (Check_Record_Representation_Clause): Do not set
	the RM size for a strict-alignment type.
	* sem_ch3.adb (Add_Interface_Tag_Components): Also set the
	Is_Independent flag along with Is_Aliased on the tag.
	(Add_Interface_Tag_Components): Likewise on the offset.
	(Analyze_Component_Declaration): Likewise on the component.
	(Analyze_Object_Declaration): Likewise on the object.
	(Constrain_Array): Likewise on the array.
	(Record_Type_Declaration: Likewise on the tag.
	(Array_Type_Declaration): Also set the
	Has_Independent_Components flag along with
	Has_Aliased_Components on the array.
	(Copy_Array_Base_Type_Attributes): Copy
	Has_Independent_Components.
	(Copy_Array_Subtype_Attributes): Copy Is_Atomic, Is_Independent
	and Is_Volatile_Full_Access.
	(Analyze_Iterator_Specification): Set Is_Independent on the loop
	variable according to Independent_Components on the array.
	* sem_ch5.adb: Likewise.
	* sem_ch6.adb (Process_Formals): Also set the Is_Independent
	flag along with Is_Aliased on the formal.

gcc/testsuite/

	* gnat.dg/specs/clause_on_volatile.ads,
	gnat.dg/specs/size_clause3.ads: Update expected diagnostics.

From-SVN: r279430
This commit is contained in:
Eric Botcazou 2019-12-16 10:34:33 +00:00 committed by Pierre-Marie de Rodat
parent 2cee58d810
commit a517d6c19a
13 changed files with 398 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
gcc/ada/ChangeLog
View File

@ -1,3 +1,59 @@
2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
validate_size.
(gnat_to_gnu_component_type): Likewise.
(gnat_to_gnu_field): Likewise and pass string for error messages.
(components_need_strict_alignment): Remove test on Is_Aliased and
add test for the independence of the component.
(validate_size): Add S1 and S2 string parameters and use them to
give better error messages for fields. Tweak a couple of messages.
* einfo.ads (Has_Independent_Components): Document more cases.
(Is_Independent): Likewise.
(Strict_Alignment): Document new semantics.
* exp_ch9.adb (Install_Private_Data_Declarations): Also set the
Is_Independent flag along with Is_Aliased on the renaming
entity.
* freeze.adb (Size_Known): Remove always-false test and add test
for the strict-alignment on the record type. Remove redundant
tests and add test for the strict-alignment on the component
type.
(Check_Strict_Alignment): Set the flag if the type is by-ref and
remove now redundant conditions. Set the flag on an array type
if it has aliased components. In the record type case, do not
set type for C_Pass_By_Copy convention.
(Freeze_Array_Type): Move code checking for conflicts between
representation aspects and clauses to before specific handling
of packed array types. Give a warnind instead of an error for a
conflict with pragma Pack. Do not test Has_Pragma_Pack for the
specific handling of packed array types.
(Freeze_Record_Type): Move error checking of representation
clause to...
(Freeze_Entity): ...here after Check_Strict_Alignment is called.
* sem_aggr.adb (Array_Aggr_Subtype): Also set the Is_Independent
flag along with Is_Aliased on the Itype.
* sem_ch13.adb (Check_Record_Representation_Clause): Do not set
the RM size for a strict-alignment type.
* sem_ch3.adb (Add_Interface_Tag_Components): Also set the
Is_Independent flag along with Is_Aliased on the tag.
(Add_Interface_Tag_Components): Likewise on the offset.
(Analyze_Component_Declaration): Likewise on the component.
(Analyze_Object_Declaration): Likewise on the object.
(Constrain_Array): Likewise on the array.
(Record_Type_Declaration: Likewise on the tag.
(Array_Type_Declaration): Also set the
Has_Independent_Components flag along with
Has_Aliased_Components on the array.
(Copy_Array_Base_Type_Attributes): Copy
Has_Independent_Components.
(Copy_Array_Subtype_Attributes): Copy Is_Atomic, Is_Independent
and Is_Volatile_Full_Access.
(Analyze_Iterator_Specification): Set Is_Independent on the loop
variable according to Independent_Components on the array.
* sem_ch5.adb: Likewise.
* sem_ch6.adb (Process_Formals): Also set the Is_Independent
flag along with Is_Aliased on the formal.
2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent

25
gcc/ada/einfo.ads
View File

@ -1725,7 +1725,8 @@ package Einfo is
-- has independent components is to see if either the object or its base
-- type has this flag set. Note that in the case of a type, the pragma
-- will be chained to the rep item chain of the first subtype in the
-- usual manner.
-- usual manner. Also set if a pragma Has_Atomic_Components or pragma
-- Has_Aliased_Components applies to the type or object.
-- Has_Inheritable_Invariants (Flag248) [base type only]
-- Defined in all type entities. Set on private types and interface types
@ -2720,13 +2721,14 @@ package Einfo is
-- Applies to all entities, true for incomplete types and subtypes
-- Is_Independent (Flag268)
-- Defined in all type entities, and also in constants, components and
-- variables. Set if a valid pragma or aspect Independent applies to the
-- entity, or if a valid pragma or aspect Independent_Components applies
-- to the enclosing record type for a component. Also set if a pragma
-- Shared or pragma Atomic applies to the entity. In the case of private
-- and incomplete types, this flag is set in both the partial view and
-- the full view.
-- Defined in all types and objects. Set if a valid pragma or aspect
-- Independent applies to the entity, or for a component if a valid
-- pragma or aspect Independent_Components applies to the enclosing
-- record type. Also set if a pragma Shared or pragma Atomic applies to
-- the entity, or if the declaration of the entity carries the Aliased
-- keyword. For Ada 2012, also applies to formal parameters. In the
-- case of private and incomplete types, this flag is set in both the
-- partial view and the full view.
-- Is_Initial_Condition_Procedure (Flag302)
-- Defined in functions and procedures. Set for a generated procedure
@ -4448,9 +4450,10 @@ package Einfo is
-- the value of attribute 'Old's prefix.
-- Strict_Alignment (Flag145) [implementation base type only]
-- Defined in all type entities. Indicates that some containing part
-- is either aliased or tagged. This prohibits packing the object
-- tighter than its natural size and alignment.
-- Defined in all type entities. Indicates that the type is by-reference
-- or contains an aliased part. This forbids packing a component of this
-- type tighter than the alignment and size of the type, as specified by
-- RM 13.2(7) modified by AI12-001 as a Binding Interpretation.
-- String_Literal_Length (Uint16)
-- Defined in string literal subtypes (which are created to correspond

7
gcc/ada/exp_ch9.adb
View File

@ -13721,9 +13721,10 @@ package body Exp_Ch9 is
Set_Ekind (Decl_Id, E_Variable);
end if;
Set_Prival (Comp_Id, Decl_Id);
Set_Prival_Link (Decl_Id, Comp_Id);
Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id));
Set_Prival (Comp_Id, Decl_Id);
Set_Prival_Link (Decl_Id, Comp_Id);
Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id));
Set_Is_Independent (Decl_Id, Is_Independent (Comp_Id));
-- Generate:
-- comp_name : comp_typ renames _object.comp_name;

373
gcc/ada/freeze.adb
View File

@ -937,8 +937,9 @@ package body Freeze is
-- size of packed records if we can tell the size of the packed
-- record in the front end. Packed_Size_Known is True if so far
-- we can figure out the size. It is initialized to True for a
-- packed record, unless the record has discriminants or atomic
-- components or independent components.
-- packed record, unless the record has either discriminants or
-- independent components, or is a strict-alignment type, since
-- it cannot be fully packed in this case.
-- The reason we eliminate the discriminated case is that
-- we don't know the way the back end lays out discriminated
@ -948,8 +949,8 @@ package body Freeze is
Packed_Size_Known : Boolean :=
Is_Packed (T)
and then not Has_Discriminants (T)
and then not Has_Atomic_Components (T)
and then not Has_Independent_Components (T);
and then not Has_Independent_Components (T)
and then not Strict_Alignment (T);
Packed_Size : Uint := Uint_0;
-- Size in bits so far
@ -997,17 +998,13 @@ package body Freeze is
Packed_Size_Known := False;
end if;
-- We do not know the packed size for an atomic/VFA type
-- or component, or an independent type or component, or a
-- by-reference type or aliased component (because packing
-- does not touch these).
-- We do not know the packed size for an independent
-- component or if it is of a strict-alignment type,
-- since packing does not touch these (RM 13.2(7)).
if Is_Atomic_Or_VFA (Ctyp)
or else Is_Atomic_Or_VFA (Comp)
if Is_Independent (Comp)
or else Is_Independent (Ctyp)
or else Is_Independent (Comp)
or else Is_By_Reference_Type (Ctyp)
or else Is_Aliased (Comp)
or else Strict_Alignment (Ctyp)
then
Packed_Size_Known := False;
end if;
@ -1613,23 +1610,33 @@ package body Freeze is
Comp : Entity_Id;
begin
if Is_Tagged_Type (E) or else Is_Concurrent_Type (E) then
if Is_By_Reference_Type (E) then
Set_Strict_Alignment (E);
elsif Is_Array_Type (E) then
Set_Strict_Alignment (E, Strict_Alignment (Component_Type (E)));
if Has_Aliased_Components (E)
or else Strict_Alignment (Component_Type (E))
then
Set_Strict_Alignment (E);
end if;
elsif Is_Record_Type (E) then
if Is_Limited_Record (E) then
Set_Strict_Alignment (E);
-- ??? If the type has convention C_Pass_By_Copy, we consider
-- that it may be packed even if it contains aliased parts.
-- Such types are very unlikely to be misaligned in practice
-- and this makes the compiler accept dubious representation
-- clauses used in Florist on types containing arrays with
-- aliased components.
if C_Pass_By_Copy (E) then
return;
end if;
Comp := First_Component (E);
while Present (Comp) loop
if not Is_Type (Comp)
and then (Strict_Alignment (Etype (Comp))
or else Is_Aliased (Comp))
and then (Is_Aliased (Comp)
or else Strict_Alignment (Etype (Comp)))
then
Set_Strict_Alignment (E);
return;
@ -2622,6 +2629,152 @@ package body Freeze is
end;
end if;
-- Check for Aliased or Atomic_Components/Atomic/VFA with
-- unsuitable packing or explicit component size clause given.
if (Has_Aliased_Components (Arr)
or else Has_Atomic_Components (Arr)
or else Is_Atomic_Or_VFA (Ctyp))
and then
(Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
then
Alias_Atomic_Check : declare
procedure Complain_CS (T : String);
-- Outputs error messages for incorrect CS clause or pragma
-- Pack for aliased or atomic/VFA components (T is "aliased"
-- or "atomic/vfa");
-----------------
-- Complain_CS --
-----------------
procedure Complain_CS (T : String) is
begin
if Has_Component_Size_Clause (Arr) then
Clause :=
Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size);
Error_Msg_N
("incorrect component size for "
& T & " components", Clause);
Error_Msg_Uint_1 := Esize (Ctyp);
Error_Msg_N
("\only allowed value is^", Clause);
else
Error_Msg_N
("?cannot pack " & T & " components (RM 13.2(7))",
Get_Rep_Pragma (FS, Name_Pack));
Set_Is_Packed (Arr, False);
end if;
end Complain_CS;
-- Start of processing for Alias_Atomic_Check
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First check for
-- object size of component type multiple of the storage
-- unit size.
elsif Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case if RM
-- size is known and static and same as the object size.
and then
((Known_Static_RM_Size (Ctyp)
and then Esize (Ctyp) = RM_Size (Ctyp))
-- Or if we have an explicit component size clause and
-- the component size and object size are equal.
or else
(Has_Component_Size_Clause (Arr)
and then Component_Size (Arr) = Esize (Ctyp)))
then
null;
elsif Has_Aliased_Components (Arr) then
Complain_CS ("aliased");
elsif Has_Atomic_Components (Arr)
or else Is_Atomic (Ctyp)
then
Complain_CS ("atomic");
elsif Is_Volatile_Full_Access (Ctyp) then
Complain_CS ("volatile full access");
end if;
end Alias_Atomic_Check;
end if;
-- Check for Independent_Components/Independent with unsuitable
-- packing or explicit component size clause given.
if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp))
and then
(Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
then
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First check for
-- object size of component type multiple of the storage
-- unit size.
elsif Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case if RM
-- size is known and multiple of the storage unit size.
and then
((Known_Static_RM_Size (Ctyp)
and then RM_Size (Ctyp) mod System_Storage_Unit = 0)
-- Or if we have an explicit component size clause and
-- the component size is larger than the object size.
or else
(Has_Component_Size_Clause (Arr)
and then Component_Size (Arr) >= Esize (Ctyp)))
then
null;
else
if Has_Component_Size_Clause (Arr) then
Clause :=
Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size);
Error_Msg_N
("incorrect component size for "
& "independent components", Clause);
Error_Msg_Uint_1 := Esize (Ctyp);
Error_Msg_N
("\minimum allowed is^", Clause);
else
Error_Msg_N
("?cannot pack independent components (RM 13.2(7))",
Get_Rep_Pragma (FS, Name_Pack));
Set_Is_Packed (Arr, False);
end if;
end if;
end;
end if;
-- If packing was requested or if the component size was
-- set explicitly, then see if bit packing is required. This
-- processing is only done for base types, since all of the
@ -2637,7 +2790,7 @@ package body Freeze is
Esiz : Uint;
begin
if (Is_Packed (Arr) or else Has_Pragma_Pack (Arr))
if Is_Packed (Arr)
and then Known_Static_RM_Size (Ctyp)
and then not Has_Component_Size_Clause (Arr)
then
@ -2797,150 +2950,6 @@ package body Freeze is
end if;
end;
-- Check for Aliased or Atomic_Components/Atomic/VFA with
-- unsuitable packing or explicit component size clause given.
if (Has_Aliased_Components (Arr)
or else Has_Atomic_Components (Arr)
or else Is_Atomic_Or_VFA (Ctyp))
and then
(Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
then
Alias_Atomic_Check : declare
procedure Complain_CS (T : String);
-- Outputs error messages for incorrect CS clause or pragma
-- Pack for aliased or atomic/VFA components (T is "aliased"
-- or "atomic/vfa");
-----------------
-- Complain_CS --
-----------------
procedure Complain_CS (T : String) is
begin
if Has_Component_Size_Clause (Arr) then
Clause :=
Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size);
Error_Msg_N
("incorrect component size for "
& T & " components", Clause);
Error_Msg_Uint_1 := Esize (Ctyp);
Error_Msg_N
("\only allowed value is^", Clause);
else
Error_Msg_N
("cannot pack " & T & " components",
Get_Rep_Pragma (FS, Name_Pack));
end if;
end Complain_CS;
-- Start of processing for Alias_Atomic_Check
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First check for
-- object size of component type multiple of the storage
-- unit size.
elsif Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case if RM
-- size is known and static and same as the object size.
and then
((Known_Static_RM_Size (Ctyp)
and then Esize (Ctyp) = RM_Size (Ctyp))
-- Or if we have an explicit component size clause and
-- the component size and object size are equal.
or else
(Has_Component_Size_Clause (Arr)
and then Component_Size (Arr) = Esize (Ctyp)))
then
null;
elsif Has_Aliased_Components (Arr) then
Complain_CS ("aliased");
elsif Has_Atomic_Components (Arr)
or else Is_Atomic (Ctyp)
then
Complain_CS ("atomic");
elsif Is_Volatile_Full_Access (Ctyp) then
Complain_CS ("volatile full access");
end if;
end Alias_Atomic_Check;
end if;
-- Check for Independent_Components/Independent with unsuitable
-- packing or explicit component size clause given.
if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp))
and then
(Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
then
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First check for
-- object size of component type multiple of the storage
-- unit size.
elsif Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case if RM
-- size is known and multiple of the storage unit size.
and then
((Known_Static_RM_Size (Ctyp)
and then RM_Size (Ctyp) mod System_Storage_Unit = 0)
-- Or if we have an explicit component size clause and
-- the component size is larger than the object size.
or else
(Has_Component_Size_Clause (Arr)
and then Component_Size (Arr) >= Esize (Ctyp)))
then
null;
else
if Has_Component_Size_Clause (Arr) then
Clause :=
Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size);
Error_Msg_N
("incorrect component size for "
& "independent components", Clause);
Error_Msg_Uint_1 := Esize (Ctyp);
Error_Msg_N
("\minimum allowed is^", Clause);
else
Error_Msg_N
("cannot pack independent components",
Get_Rep_Pragma (FS, Name_Pack));
end if;
end if;
end;
end if;
-- Warn for case of atomic type
Clause := Get_Rep_Pragma (FS, Name_Atomic);
@ -4589,18 +4598,6 @@ package body Freeze is
end if;
end if;
-- Complete error checking on record representation clause (e.g.
-- overlap of components). This is called after adjusting the
-- record for reverse bit order.
declare
RRC : constant Node_Id := Get_Record_Representation_Clause (Rec);
begin
if Present (RRC) then
Check_Record_Representation_Clause (RRC);
end if;
end;
-- Check for useless pragma Pack when all components placed. We only
-- do this check for record types, not subtypes, since a subtype may
-- have all its components placed, and it still makes perfectly good
@ -6792,17 +6789,29 @@ package body Freeze is
end if;
end if;
-- Now that all types from which E may depend are frozen, see if the
-- size is known at compile time, if it must be unsigned, or if
-- strict alignment is required
Check_Compile_Time_Size (E);
Check_Unsigned_Type (E);
-- Now that all types from which E may depend are frozen, see if
-- strict alignment is required, a component clause on a record
-- is correct, the size is known at compile time and if it must
-- be unsigned, in that order.
if Base_Type (E) = E then
Check_Strict_Alignment (E);
end if;
if Ekind_In (E, E_Record_Type, E_Record_Subtype) then
declare
RC : constant Node_Id := Get_Record_Representation_Clause (E);
begin
if Present (RC) then
Check_Record_Representation_Clause (RC);
end if;
end;
end if;
Check_Compile_Time_Size (E);
Check_Unsigned_Type (E);
-- Do not allow a size clause for a type which does not have a size
-- that is known at compile time

102
gcc/ada/gcc-interface/decl.c
View File

@ -233,7 +233,8 @@ static vec<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool);
static vec<variant_desc> build_variant_list (tree, vec<subst_pair>,
vec<variant_desc>);
static tree maybe_saturate_size (tree);
static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool,
const char *, const char *);
static void set_rm_size (Uint, tree, Entity_Id);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static unsigned int promote_object_alignment (tree, Entity_Id);
@ -780,7 +781,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
if (Known_Esize (gnat_entity))
gnu_size
= validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
VAR_DECL, false, Has_Size_Clause (gnat_entity));
VAR_DECL, false, Has_Size_Clause (gnat_entity),
NULL, NULL);
if (gnu_size)
{
gnu_type
@ -4243,7 +4245,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
? Esize (gnat_entity) : RM_Size (gnat_entity);
gnu_size
= validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL,
false, Has_Size_Clause (gnat_entity));
false, Has_Size_Clause (gnat_entity), NULL, NULL);
}
/* If a size was specified, see if we can make a new type of that size
@ -5090,8 +5092,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
/* Get and validate any specified Component_Size. */
gnu_comp_size
= validate_size (Component_Size (gnat_array), gnu_type, gnat_array,
has_packed_components ? TYPE_DECL : VAR_DECL,
true, Has_Component_Size_Clause (gnat_array));
has_packed_components ? TYPE_DECL : VAR_DECL, true,
Has_Component_Size_Clause (gnat_array), NULL, NULL);
/* If the component type is a RECORD_TYPE that has a self-referential size,
then use the maximum size for the component size. */
@ -6999,6 +7001,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
const Node_Id gnat_clause = Component_Clause (gnat_field);
const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field));
const Entity_Id gnat_field_type = Etype (gnat_field);
tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
tree gnu_field_id = get_entity_name (gnat_field);
const bool is_atomic
= (Is_Atomic_Or_VFA (gnat_field) || Is_Atomic_Or_VFA (gnat_field_type));
const bool is_aliased = Is_Aliased (gnat_field);
@ -7006,6 +7010,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
= (Is_Independent (gnat_field) || Is_Independent (gnat_field_type));
const bool is_volatile
= (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
const bool is_by_ref = TYPE_IS_BY_REFERENCE_P (gnu_field_type);
const bool is_strict_alignment = Strict_Alignment (gnat_field_type);
/* We used to consider that volatile fields also require strict alignment,
but that was an interpolation and would cause us to reject a pragma
@ -7014,16 +7019,36 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
involve load-modify-store sequences, but that's OK for volatile. The
only constraint is the implementation advice whereby only the bits of
the components should be accessed if they both start and end on byte
boundaries, but that should be guaranteed by the GCC memory model. */
const bool needs_strict_alignment
= (is_atomic || is_aliased || is_independent || is_strict_alignment);
bool is_bitfield;
tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
tree gnu_field_id = get_entity_name (gnat_field);
boundaries, but that should be guaranteed by the GCC memory model.
Note that we have some redundancies (is_atomic => is_independent,
is_aliased => is_independent and is_by_ref => is_strict_alignment)
so the following formula is sufficient. */
const bool needs_strict_alignment = (is_independent || is_strict_alignment);
const char *field_s, *size_s;
tree gnu_field, gnu_size, gnu_pos;
bool is_bitfield;
/* If this field requires strict alignment, we cannot pack it because
it would very likely be under-aligned in the record. */
/* The qualifier to be used in messages. */
if (is_atomic)
field_s = "atomic&";
else if (is_aliased)
field_s = "aliased&";
else if (is_independent)
field_s = "independent&";
else if (is_by_ref)
field_s = "& with by-reference type";
else if (is_strict_alignment)
field_s = "& with aliased part";
else
field_s = "&";
/* The message to be used for incompatible size. */
if (is_atomic || is_aliased)
size_s = "size for %s must be ^";
else if (field_s)
size_s = "size for %s too small{, minimum allowed is ^}";
/* If a field requires strict alignment, we cannot pack it (RM 13.2(7)). */
if (needs_strict_alignment)
packed = 0;
else
@ -7034,7 +7059,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
for further details. */
if (Present (gnat_clause) || Known_Esize (gnat_field))
gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
FIELD_DECL, false, true);
FIELD_DECL, false, true, size_s, field_s);
else if (packed == 1)
{
gnu_size = rm_size (gnu_field_type);
@ -7152,23 +7177,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
&& !(type_annotate_only && Is_Tagged_Type (gnat_field_type)))
{
const unsigned int type_align = TYPE_ALIGN (gnu_field_type);
const char *field_s;
if (TYPE_ALIGN (gnu_record_type)
&& TYPE_ALIGN (gnu_record_type) < type_align)
SET_TYPE_ALIGN (gnu_record_type, type_align);
if (is_atomic)
field_s = "atomic &";
else if (is_aliased)
field_s = "aliased &";
else if (is_independent)
field_s = "independent &";
else if (is_strict_alignment)
field_s = "& with aliased or tagged part";
else
gcc_unreachable ();
/* If the position is not a multiple of the storage unit, then error
out and reset the position. */
if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
@ -7221,11 +7234,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
|| (cmp > 0 && (is_atomic || is_aliased)))
{
char s[128];
if (is_atomic || is_aliased)
snprintf (s, sizeof (s), "size for %s must be ^", field_s);
else
snprintf (s, sizeof (s), "size for %s must be at least ^",
field_s);
snprintf (s, sizeof (s), size_s, field_s);
post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
type_size);
gnu_size = NULL_TREE;
@ -7362,7 +7371,7 @@ components_need_strict_alignment (Node_Id component_list)
{
Entity_Id gnat_field = Defining_Entity (component_decl);
if (Is_Aliased (gnat_field))
if (Is_Independent (gnat_field) || Is_Independent (Etype (gnat_field)))
return true;
if (Strict_Alignment (Etype (gnat_field)))
@ -8838,11 +8847,12 @@ maybe_saturate_size (tree size)
true if we are being called to process the Component_Size of GNAT_OBJECT;
this is used only for error messages. ZERO_OK is true if a size of zero
is permitted; if ZERO_OK is false, it means that a size of zero should be
treated as an unspecified size. */
treated as an unspecified size. S1 and S2 are used for error messages. */
static tree
validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
enum tree_code kind, bool component_p, bool zero_ok)
enum tree_code kind, bool component_p, bool zero_ok,
const char *s1, const char *s2)
{
Node_Id gnat_error_node;
tree old_size, size;
@ -8888,10 +8898,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
&& !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, bitsize_unit_node)))
{
if (component_p)
post_error_ne ("component size for& is not a multiple of Storage_Unit",
post_error_ne ("component size for& must be multiple of Storage_Unit",
gnat_error_node, gnat_object);
else
post_error_ne ("size for& is not a multiple of Storage_Unit",
post_error_ne ("size for& must be multiple of Storage_Unit",
gnat_error_node, gnat_object);
return NULL_TREE;
}
@ -8932,14 +8942,20 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
|| TREE_OVERFLOW (old_size)
|| tree_int_cst_lt (size, old_size))
{
if (component_p)
post_error_ne_tree
("component size for& too small{, minimum allowed is ^}",
gnat_error_node, gnat_object, old_size);
char buf[128];
const char *s;
if (kind == FIELD_DECL)
{
snprintf (buf, sizeof (buf), s1, s2);
s = buf;
}
else if (component_p)
s = "component size for& too small{, minimum allowed is ^}";
else
post_error_ne_tree
("size for& too small{, minimum allowed is ^}",
gnat_error_node, gnat_object, old_size);
s = "size for& too small{, minimum allowed is ^}";
post_error_ne_tree (s, gnat_error_node, gnat_object, old_size);
return NULL_TREE;
}

1
gcc/ada/sem_aggr.adb
View File

@ -602,6 +602,7 @@ package body Sem_Aggr is
Set_Etype (Itype, Base_Type (Typ));
Set_Has_Alignment_Clause (Itype, Has_Alignment_Clause (Typ));
Set_Is_Aliased (Itype, Is_Aliased (Typ));
Set_Is_Independent (Itype, Is_Independent (Typ));
Set_Depends_On_Private (Itype, Depends_On_Private (Typ));
Copy_Suppress_Status (Index_Check, Typ, Itype);

11
gcc/ada/sem_ch13.adb
View File

@ -10937,9 +10937,9 @@ package body Sem_Ch13 is
end if;
-- For records that have component clauses for all components, and whose
-- size is less than or equal to 32, we need to know the size in the
-- front end to activate possible packed array processing where the
-- component type is a record.
-- size is less than or equal to 32, and which can be fully packed, we
-- need to know the size in the front end to activate possible packed
-- array processing where the component type is a record.
-- At this stage Hbit + 1 represents the first unused bit from all the
-- component clauses processed, so if the component clauses are
@ -10950,7 +10950,10 @@ package body Sem_Ch13 is
-- length (it may for example be appropriate to round up the size
-- to some convenient boundary, based on alignment considerations, etc).
if Unknown_RM_Size (Rectype) and then Hbit + 1 <= 32 then
if Unknown_RM_Size (Rectype)
and then Hbit + 1 <= 32
and then not Strict_Alignment (Rectype)
then
-- Nothing to do if at least one component has no component clause

70
gcc/ada/sem_ch3.adb
View File

@ -1505,6 +1505,7 @@ package body Sem_Ch3 is
Set_Ekind (Tag, E_Component);
Set_Is_Tag (Tag);
Set_Is_Aliased (Tag);
Set_Is_Independent (Tag);
Set_Related_Type (Tag, Iface);
Init_Component_Location (Tag);
@ -1544,6 +1545,7 @@ package body Sem_Ch3 is
Set_Analyzed (Decl);
Set_Ekind (Offset, E_Component);
Set_Is_Aliased (Offset);
Set_Is_Independent (Offset);
Set_Related_Type (Offset, Iface);
Init_Component_Location (Offset);
Insert_After (Last_Tag, Decl);
@ -2083,7 +2085,15 @@ package body Sem_Ch3 is
end if;
Set_Etype (Id, T);
Set_Is_Aliased (Id, Aliased_Present (Component_Definition (N)));
if Aliased_Present (Component_Definition (N)) then
Set_Is_Aliased (Id);
-- AI12-001: All aliased objects are considered to be specified as
-- independently addressable (RM C.6(8.1/4)).
Set_Is_Independent (Id);
end if;
-- The component declaration may have a per-object constraint, set
-- the appropriate flag in the defining identifier of the subtype.
@ -4846,6 +4856,11 @@ package body Sem_Ch3 is
if Aliased_Present (N) then
Set_Is_Aliased (Id);
-- AI12-001: All aliased objects are considered to be specified as
-- independently addressable (RM C.6(8.1/4)).
Set_Is_Independent (Id);
-- If the object is aliased and the type is unconstrained with
-- defaulted discriminants and there is no expression, then the
-- object is constrained by the defaults, so it is worthwhile
@ -6346,6 +6361,11 @@ package body Sem_Ch3 is
Check_SPARK_05_Restriction
("aliased is not allowed", Component_Definition (Def));
Set_Has_Aliased_Components (Etype (T));
-- AI12-001: All aliased objects are considered to be specified as
-- independently addressable (RM C.6(8.1/4)).
Set_Has_Independent_Components (Etype (T));
end if;
-- Ada 2005 (AI-231): Propagate the null-excluding attribute to the
@ -13237,6 +13257,7 @@ package body Sem_Ch3 is
Set_Is_Constrained (Def_Id, True);
Set_Is_Aliased (Def_Id, Is_Aliased (T));
Set_Is_Independent (Def_Id, Is_Independent (T));
Set_Depends_On_Private (Def_Id, Has_Private_Component (Def_Id));
Set_Is_Private_Composite (Def_Id, Is_Private_Composite (T));
@ -14579,16 +14600,17 @@ package body Sem_Ch3 is
procedure Copy_Array_Base_Type_Attributes (T1, T2 : Entity_Id) is
begin
Set_Component_Alignment (T1, Component_Alignment (T2));
Set_Component_Type (T1, Component_Type (T2));
Set_Component_Size (T1, Component_Size (T2));
Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2));
Propagate_Concurrent_Flags (T1, T2);
Set_Is_Packed (T1, Is_Packed (T2));
Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2));
Set_Has_Atomic_Components (T1, Has_Atomic_Components (T2));
Set_Has_Volatile_Components (T1, Has_Volatile_Components (T2));
Set_Component_Alignment (T1, Component_Alignment (T2));
Set_Component_Type (T1, Component_Type (T2));
Set_Component_Size (T1, Component_Size (T2));
Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2));
Propagate_Concurrent_Flags (T1, T2);
Set_Is_Packed (T1, Is_Packed (T2));
Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2));
Set_Has_Atomic_Components (T1, Has_Atomic_Components (T2));
Set_Has_Independent_Components (T1, Has_Independent_Components (T2));
Set_Has_Volatile_Components (T1, Has_Volatile_Components (T2));
end Copy_Array_Base_Type_Attributes;
-----------------------------------
@ -14599,17 +14621,20 @@ package body Sem_Ch3 is
begin
Set_Size_Info (T1, T2);
Set_First_Index (T1, First_Index (T2));
Set_Is_Aliased (T1, Is_Aliased (T2));
Set_Is_Volatile (T1, Is_Volatile (T2));
Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2));
Set_Is_Constrained (T1, Is_Constrained (T2));
Set_Depends_On_Private (T1, Has_Private_Component (T2));
Inherit_Rep_Item_Chain (T1, T2);
Set_Convention (T1, Convention (T2));
Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
Set_First_Index (T1, First_Index (T2));
Set_Is_Aliased (T1, Is_Aliased (T2));
Set_Is_Atomic (T1, Is_Atomic (T2));
Set_Is_Independent (T1, Is_Independent (T2));
Set_Is_Volatile (T1, Is_Volatile (T2));
Set_Is_Volatile_Full_Access (T1, Is_Volatile_Full_Access (T2));
Set_Treat_As_Volatile (T1, Treat_As_Volatile (T2));
Set_Is_Constrained (T1, Is_Constrained (T2));
Set_Depends_On_Private (T1, Has_Private_Component (T2));
Inherit_Rep_Item_Chain (T1, T2);
Set_Convention (T1, Convention (T2));
Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
end Copy_Array_Subtype_Attributes;
-----------------------------------
@ -22069,6 +22094,7 @@ package body Sem_Ch3 is
Set_Ekind (Tag_Comp, E_Component);
Set_Is_Tag (Tag_Comp);
Set_Is_Aliased (Tag_Comp);
Set_Is_Independent (Tag_Comp);
Set_Etype (Tag_Comp, RTE (RE_Tag));
Set_DT_Entry_Count (Tag_Comp, No_Uint);
Set_Original_Record_Component (Tag_Comp, Tag_Comp);

5
gcc/ada/sem_ch5.adb
View File

@ -2441,9 +2441,10 @@ package body Sem_Ch5 is
Set_Etype (Def_Id, Component_Type (Typ));
-- The loop variable is aliased if the array components are
-- aliased.
-- aliased. Likewise for the independent aspect.
Set_Is_Aliased (Def_Id, Has_Aliased_Components (Typ));
Set_Is_Aliased (Def_Id, Has_Aliased_Components (Typ));
Set_Is_Independent (Def_Id, Has_Independent_Components (Typ));
-- AI12-0047 stipulates that the domain (array or container)
-- cannot be a component that depends on a discriminant if the

5
gcc/ada/sem_ch6.adb
View File

@ -11654,6 +11654,11 @@ package body Sem_Ch6 is
and then Aliased_Present (Param_Spec)
then
Set_Is_Aliased (Formal);
-- AI12-001: All aliased objects are considered to be specified
-- as independently addressable (RM C.6(8.1/4)).
Set_Is_Independent (Formal);
end if;
-- Ada 2005 (AI-231): Create and decorate an internal subtype

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-12-16 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/clause_on_volatile.ads,
gnat.dg/specs/size_clause3.ads: Update expected diagnostics.
2019-12-16 Andreas Krebbel <krebbel@linux.ibm.com>
PR target/92950

6
gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
View File

@ -57,7 +57,7 @@ package Clause_On_Volatile is
end record;
For V1'Alignment use 4;
for V1 use record
VW at 0 range 0 .. 15;
VW at 0 range 0 .. 15; -- { dg-error "too small*" }
end record;
type V2 is record
@ -67,7 +67,7 @@ package Clause_On_Volatile is
For V2'Alignment use 4;
for V2 use record
B at 0 range 0 .. 7;
VW at 1 range 0 .. 31;
VW at 1 range 0 .. 31; -- { dg-error "must be multiple|alignment" }
end record;
type V3 is record
@ -77,7 +77,7 @@ package Clause_On_Volatile is
For V3'Alignment use 4;
for V3 use record
B at 0 range 0 .. 7;
VW at 1 range 0 .. 15;
VW at 1 range 0 .. 15; -- { dg-error "must be multiple|alignment|too small" }
end record;
end Clause_On_Volatile;

4
gcc/testsuite/gnat.dg/specs/size_clause3.ads
View File

@ -14,7 +14,7 @@ package Size_Clause3 is
rr : R1; -- size must be 40
end record;
for S1 use record
rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" }
rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased part too small" }
end record;
-- The record is explicitly given alignment 1 so its real type is 40.
@ -44,7 +44,7 @@ package Size_Clause3 is
rr : R3; -- size must be 40
end record;
for S3 use record
rr at 0 range 0 .. 39; -- { dg-error "size for .rr. too small" }
rr at 0 range 0 .. 39; -- { dg-error "size for .rr. with aliased part too small" }
end record;
end Size_Clause3;