Skip to content

R
riscv-gcc-1
Commit f2bee239 by Eric Botcazou Committed by Pierre-Marie de Rodat
Options

[Ada] Fix -gnatR3 output for dynamically constrained record 

2018-12-11  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/decl.c (gnat_to_gnu_entity): Add
	gnat_annotate_type local variable initialized to Empty.
	<E_Record_Subtype>: Set it to the Cloned_Subtype, if any.  For
	types, back-annotate alignment and size values earlier and only
	if the DECL was created here; otherwise, if gnat_annotate_type
	is present, take the values from it.
	(gnat_to_gnu_field): Add gnat_clause local variable.  If a
	component clause is present, call validate_size only once on the
	Esize of the component.  Otherwise, in the packed case, do not
	call validate_size again on the type of the component but
	retrieve directly its RM size.
	(components_to_record): Minor tweak.
	(set_rm_size): Remove useless test.
	* gcc-interface/trans.c (gnat_to_gnu): Do wrap the instance of a
	boolean discriminant attached to a variant part.

From-SVN: r267008
parent 619bfd9f
Showing with 138 additions and 111 deletions
gcc/ada/ChangeLog
2018-12-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Add
gnat_annotate_type local variable initialized to Empty.
<E_Record_Subtype>: Set it to the Cloned_Subtype, if any. For
types, back-annotate alignment and size values earlier and only
if the DECL was created here; otherwise, if gnat_annotate_type
is present, take the values from it.
(gnat_to_gnu_field): Add gnat_clause local variable. If a
component clause is present, call validate_size only once on the
Esize of the component. Otherwise, in the packed case, do not
call validate_size again on the type of the component but
retrieve directly its RM size.
(components_to_record): Minor tweak.
(set_rm_size): Remove useless test.
* gcc-interface/trans.c (gnat_to_gnu): Do wrap the instance of a
boolean discriminant attached to a variant part.
2018-12-11 Ed Schonberg <schonberg@adacore.com> 2018-12-11 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Array_Aggr_Subtype. Resolve_Aggr_Expr): Indicate * sem_aggr.adb (Array_Aggr_Subtype. Resolve_Aggr_Expr): Indicate
......
gcc/ada/gcc-interface/decl.c
...@@ -287,6 +287,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -287,6 +287,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
const bool foreign = Has_Foreign_Convention (gnat_entity); const bool foreign = Has_Foreign_Convention (gnat_entity);
/* For a type, contains the equivalent GNAT node to be used in gigi. */ /* For a type, contains the equivalent GNAT node to be used in gigi. */
Entity_Id gnat_equiv_type = Empty; Entity_Id gnat_equiv_type = Empty;
/* For a type, contains the GNAT node to be used for back-annotation. */
Entity_Id gnat_annotate_type = Empty;
/* Temporary used to walk the GNAT tree. */ /* Temporary used to walk the GNAT tree. */
Entity_Id gnat_temp; Entity_Id gnat_temp;
/* Contains the GCC DECL node which is equivalent to the input GNAT node. /* Contains the GCC DECL node which is equivalent to the input GNAT node.
...@@ -3390,6 +3392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -3390,6 +3392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
{ {
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, false); NULL_TREE, false);
gnat_annotate_type = Cloned_Subtype (gnat_entity);
saved = true; saved = true;
break; break;
} }
...@@ -4228,7 +4231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4228,7 +4231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
saved = true; saved = true;
} }
/* If we are processing a type and there is either no decl for it or /* If we are processing a type and there is either no DECL for it or
we just made one, do some common processing for the type, such as we just made one, do some common processing for the type, such as
handling alignment and possible padding. */ handling alignment and possible padding. */
if (is_type && (!gnu_decl || this_made_decl)) if (is_type && (!gnu_decl || this_made_decl))
...@@ -4324,6 +4327,97 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4324,6 +4327,97 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
because we need to accept arbitrary RM sizes on integral types. */ because we need to accept arbitrary RM sizes on integral types. */
set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity); set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity);
/* Back-annotate the alignment of the type if not already set. */
if (Unknown_Alignment (gnat_entity))
{
unsigned int double_align, align;
bool is_capped_double, align_clause;
/* If the default alignment of "double" or larger scalar types is
specifically capped and this is not an array with an alignment
clause on the component type, return the cap. */
if ((double_align = double_float_alignment) > 0)
is_capped_double
= is_double_float_or_array (gnat_entity, &align_clause);
else if ((double_align = double_scalar_alignment) > 0)
is_capped_double
= is_double_scalar_or_array (gnat_entity, &align_clause);
else
is_capped_double = align_clause = false;
if (is_capped_double && !align_clause)
align = double_align;
else
align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
Set_Alignment (gnat_entity, UI_From_Int (align));
}
/* Likewise for the size, if any. */
if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
{
tree gnu_size = TYPE_SIZE (gnu_type);
/* If the size is self-referential, annotate the maximum value. */
if (CONTAINS_PLACEHOLDER_P (gnu_size))
gnu_size = max_size (gnu_size, true);
/* If we are just annotating types and the type is tagged, the tag
and the parent components are not generated by the front-end so
alignment and sizes must be adjusted if there is no rep clause. */
if (type_annotate_only
&& Is_Tagged_Type (gnat_entity)
&& Unknown_RM_Size (gnat_entity)
&& !VOID_TYPE_P (gnu_type)
&& (!TYPE_FIELDS (gnu_type)
|| integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
{
tree offset;
if (Is_Derived_Type (gnat_entity))
{
Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
Set_Alignment (gnat_entity, Alignment (gnat_parent));
}
else
{
unsigned int align
= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
offset = bitsize_int (POINTER_SIZE);
Set_Alignment (gnat_entity, UI_From_Int (align));
}
if (TYPE_FIELDS (gnu_type))
offset
= round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
gnu_size = round_up (gnu_size, POINTER_SIZE);
Uint uint_size = annotate_value (gnu_size);
Set_RM_Size (gnat_entity, uint_size);
Set_Esize (gnat_entity, uint_size);
}
/* If there is a rep clause, only adjust alignment and Esize. */
else if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
unsigned int align
= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
Set_Alignment (gnat_entity, UI_From_Int (align));
gnu_size = round_up (gnu_size, POINTER_SIZE);
Set_Esize (gnat_entity, annotate_value (gnu_size));
}
/* Otherwise no adjustment is needed. */
else
Set_Esize (gnat_entity, annotate_value (gnu_size));
}
/* Likewise for the RM size, if any. */
if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
/* If we are at global level, GCC will have applied variable_size to /* If we are at global level, GCC will have applied variable_size to
the type, but that won't have done anything. So, if it's not the type, but that won't have done anything. So, if it's not
a constant or self-referential, call elaborate_expression_1 to a constant or self-referential, call elaborate_expression_1 to
...@@ -4575,99 +4669,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4575,99 +4669,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
debug_info_p, gnat_entity); debug_info_p, gnat_entity);
} }
/* If we got a type that is not dummy, back-annotate the alignment of the /* Otherwise, for a type reusing an existing DECL, back-annotate values. */
type if not already in the tree. Likewise for the size, if any. */ else if (is_type
if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))) && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
&& Present (gnat_annotate_type))
{ {
gnu_type = TREE_TYPE (gnu_decl);
if (Unknown_Alignment (gnat_entity)) if (Unknown_Alignment (gnat_entity))
{ Set_Alignment (gnat_entity, Alignment (gnat_annotate_type));
unsigned int double_align, align; if (Unknown_Esize (gnat_entity))
bool is_capped_double, align_clause; Set_Esize (gnat_entity, Esize (gnat_annotate_type));
if (Unknown_RM_Size (gnat_entity))
/* If the default alignment of "double" or larger scalar types is Set_RM_Size (gnat_entity, RM_Size (gnat_annotate_type));
specifically capped and this is not an array with an alignment
clause on the component type, return the cap. */
if ((double_align = double_float_alignment) > 0)
is_capped_double
= is_double_float_or_array (gnat_entity, &align_clause);
else if ((double_align = double_scalar_alignment) > 0)
is_capped_double
= is_double_scalar_or_array (gnat_entity, &align_clause);
else
is_capped_double = align_clause = false;
if (is_capped_double && !align_clause)
align = double_align;
else
align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
Set_Alignment (gnat_entity, UI_From_Int (align));
}
if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
{
tree gnu_size = TYPE_SIZE (gnu_type);
/* If the size is self-referential, annotate the maximum value. */
if (CONTAINS_PLACEHOLDER_P (gnu_size))
gnu_size = max_size (gnu_size, true);
/* If we are just annotating types and the type is tagged, the tag
and the parent components are not generated by the front-end so
alignment and sizes must be adjusted if there is no rep clause. */
if (type_annotate_only
&& Is_Tagged_Type (gnat_entity)
&& Unknown_RM_Size (gnat_entity)
&& !VOID_TYPE_P (gnu_type)
&& (!TYPE_FIELDS (gnu_type)
|| integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
{
tree offset;
if (Is_Derived_Type (gnat_entity))
{
Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
Set_Alignment (gnat_entity, Alignment (gnat_parent));
}
else
{
unsigned int align
= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
offset = bitsize_int (POINTER_SIZE);
Set_Alignment (gnat_entity, UI_From_Int (align));
}
if (TYPE_FIELDS (gnu_type))
offset
= round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
gnu_size = round_up (gnu_size, POINTER_SIZE);
Uint uint_size = annotate_value (gnu_size);
Set_RM_Size (gnat_entity, uint_size);
Set_Esize (gnat_entity, uint_size);
}
/* If there is a rep clause, only adjust alignment and Esize. */
else if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
unsigned int align
= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
Set_Alignment (gnat_entity, UI_From_Int (align));
gnu_size = round_up (gnu_size, POINTER_SIZE);
Set_Esize (gnat_entity, annotate_value (gnu_size));
}
/* Otherwise no adjustment is needed. */
else
Set_Esize (gnat_entity, annotate_value (gnu_size));
}
if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
} }
/* If we haven't already, associate the ..._DECL node that we just made with /* If we haven't already, associate the ..._DECL node that we just made with
...@@ -6900,6 +6912,7 @@ static tree ...@@ -6900,6 +6912,7 @@ static tree
gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
bool definition, bool debug_info_p) bool definition, bool debug_info_p)
{ {
const Node_Id gnat_clause = Component_Clause (gnat_field);
const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field)); const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field));
const Entity_Id gnat_field_type = Etype (gnat_field); const Entity_Id gnat_field_type = Etype (gnat_field);
const bool is_atomic const bool is_atomic
...@@ -6934,12 +6947,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6934,12 +6947,15 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
/* If a size is specified, use it. Otherwise, if the record type is packed, /* If a size is specified, use it. Otherwise, if the record type is packed,
use the official RM size. See "Handling of Type'Size Values" in Einfo use the official RM size. See "Handling of Type'Size Values" in Einfo
for further details. */ for further details. */
if (Known_Esize (gnat_field)) if (Known_Esize (gnat_field) || Present (gnat_clause))
gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
gnat_field, FIELD_DECL, false, true); FIELD_DECL, false, true);
else if (packed == 1) else if (packed == 1)
gnu_size = validate_size (RM_Size (gnat_field_type), gnu_field_type, {
gnat_field, FIELD_DECL, false, true); gnu_size = rm_size (gnu_field_type);
if (TREE_CODE (gnu_size) != INTEGER_CST)
gnu_size = NULL_TREE;
}
else else
gnu_size = NULL_TREE; gnu_size = NULL_TREE;
...@@ -6972,7 +6988,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6972,7 +6988,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
&& (packed == 1 && (packed == 1
|| (gnu_size || (gnu_size
&& (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)) && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
|| (Present (Component_Clause (gnat_field)) || (Present (gnat_clause)
&& !(UI_To_Int (Component_Bit_Offset (gnat_field)) && !(UI_To_Int (Component_Bit_Offset (gnat_field))
% BITS_PER_UNIT == 0 % BITS_PER_UNIT == 0
&& value_factor_p (gnu_size, BITS_PER_UNIT))))))) && value_factor_p (gnu_size, BITS_PER_UNIT)))))))
...@@ -6997,14 +7013,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6997,14 +7013,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
check_ok_for_atomic_type (gnu_field_type, gnat_field, false); check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
} }
if (Present (Component_Clause (gnat_field))) if (Present (gnat_clause))
{ {
Node_Id gnat_clause = Component_Clause (gnat_field);
Entity_Id gnat_parent = Parent_Subtype (gnat_record_type); Entity_Id gnat_parent = Parent_Subtype (gnat_record_type);
gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype); gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype);
gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true);
/* Ensure the position does not overlap with the parent subtype, if there /* Ensure the position does not overlap with the parent subtype, if there
is one. This test is omitted if the parent of the tagged type has a is one. This test is omitted if the parent of the tagged type has a
...@@ -7585,7 +7598,9 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, ...@@ -7585,7 +7598,9 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
tree gnu_var_name tree gnu_var_name
= concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))), = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
"XVN"); "XVN");
tree gnu_union_type, gnu_union_name; tree gnu_union_name
= concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
tree gnu_union_type;
tree this_first_free_pos, gnu_variant_list = NULL_TREE; tree this_first_free_pos, gnu_variant_list = NULL_TREE;
bool union_field_needs_strict_alignment = false; bool union_field_needs_strict_alignment = false;
auto_vec <vinfo_t, 16> variant_types; auto_vec <vinfo_t, 16> variant_types;
...@@ -7593,9 +7608,6 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, ...@@ -7593,9 +7608,6 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
unsigned int variants_align = 0; unsigned int variants_align = 0;
unsigned int i; unsigned int i;
gnu_union_name
= concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
/* Reuse the enclosing union if this is an Unchecked_Union whose fields /* Reuse the enclosing union if this is an Unchecked_Union whose fields
are all in the variant part, to match the layout of C unions. There are all in the variant part, to match the layout of C unions. There
is an associated check below. */ is an associated check below. */
...@@ -8831,10 +8843,6 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) ...@@ -8831,10 +8843,6 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
if (uint_size == No_Uint) if (uint_size == No_Uint)
return; return;
/* Ignore a negative size since that corresponds to our back-annotation. */
if (UI_Lt (uint_size, Uint_0))
return;
/* Only issue an error if a Value_Size clause was explicitly given. /* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */ Otherwise, we'd be duplicating an error on the Size clause. */
gnat_attr_node gnat_attr_node
......
gcc/ada/gcc-interface/trans.c
...@@ -8567,7 +8567,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -8567,7 +8567,8 @@ gnat_to_gnu (Node_Id gnat_node)
|| kind == N_Indexed_Component || kind == N_Indexed_Component
|| kind == N_Selected_Component) || kind == N_Selected_Component)
&& TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE && TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE
&& !lvalue_required_p (gnat_node, gnu_result_type, false, false)) && !lvalue_required_p (gnat_node, gnu_result_type, false, false)
&& Nkind (Parent (gnat_node)) != N_Variant_Part)
{ {
gnu_result gnu_result
= build_binary_op (NE_EXPR, gnu_result_type, = build_binary_op (NE_EXPR, gnu_result_type,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment