+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
-- 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
-- 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
-- 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
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;
-- 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
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
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;
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;
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
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
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);
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
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
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);
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
? 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
/* 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. */
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);
= (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
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;
+
+ /* 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 = "&";
- /* If this field requires strict alignment, we cannot pack it because
- it would very likely be under-aligned in the record. */
+ /* 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
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);
&& !(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,
|| (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;
{
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)))
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;
&& !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;
}
|| 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;
}
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);
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
-- 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
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);
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);
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.
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
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
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));
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;
-----------------------------------
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;
-----------------------------------
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);
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
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
+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
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
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
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;
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.
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;
projects / thirdparty / gcc.git / commitdiff
