diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a3832b8234d..063043656a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,59 @@ +2019-12-16 Eric Botcazou + + * 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 * sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 0aa7e00e899..d5a26d1d638 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 60080e60066..7b8edf43509 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index de5f8f7cdd5..36cf63cad16 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b83f38c86a5..57d163169d0 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -233,7 +233,8 @@ static vec build_subst_list (Entity_Id, Entity_Id, bool); static vec build_variant_list (tree, vec, vec); 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; } diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d6d7c5967ae..e41fcdb6cc0 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e266af9265d..bbdb065908b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9554c3334f6..ca2247671e1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a65e92c0b1b..2342c544b32 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 386332c86d4..4afcf01345a 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cc1a7350d61..247064bd955 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-12-16 Eric Botcazou + + * gnat.dg/specs/clause_on_volatile.ads, + gnat.dg/specs/size_clause3.ads: Update expected diagnostics. + 2019-12-16 Andreas Krebbel PR target/92950 diff --git a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads index 0dcffbcd3a4..157f7244774 100644 --- a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads +++ b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads @@ -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; diff --git a/gcc/testsuite/gnat.dg/specs/size_clause3.ads b/gcc/testsuite/gnat.dg/specs/size_clause3.ads index 12ca2d1aba6..a9ab5c57e3a 100644 --- a/gcc/testsuite/gnat.dg/specs/size_clause3.ads +++ b/gcc/testsuite/gnat.dg/specs/size_clause3.ads @@ -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;