From f2bee2395180f0e45177ccdd92dca8f327679e46 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 11 Dec 2018 11:11:47 +0000
Subject: [PATCH] [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
---
gcc/ada/ChangeLog | 18 +++
gcc/ada/gcc-interface/decl.c | 228 ++++++++++++++++++----------------
gcc/ada/gcc-interface/trans.c | 3 +-
3 files changed, 138 insertions(+), 111 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d9dfb2240d2b..1fd528ccaf57 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+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>
* sem_aggr.adb (Array_Aggr_Subtype. Resolve_Aggr_Expr): Indicate
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index eaa1a52fd2fa..b2f92296a1a0 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -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);
/* For a type, contains the equivalent GNAT node to be used in gigi. */
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. */
Entity_Id gnat_temp;
/* 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)
{
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, false);
+ gnat_annotate_type = Cloned_Subtype (gnat_entity);
saved = true;
break;
}
@@ -4228,7 +4231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
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
handling alignment and possible padding. */
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)
because we need to accept arbitrary RM sizes on integral types. */
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
the type, but that won't have done anything. So, if it's not
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)
debug_info_p, gnat_entity);
}
- /* If we got a type that is not dummy, back-annotate the alignment of the
- type if not already in the tree. Likewise for the size, if any. */
- if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
+ /* Otherwise, for a type reusing an existing DECL, back-annotate values. */
+ else if (is_type
+ && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+ && Present (gnat_annotate_type))
{
- gnu_type = TREE_TYPE (gnu_decl);
-
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));
- }
-
- 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)));
+ Set_Alignment (gnat_entity, Alignment (gnat_annotate_type));
+ if (Unknown_Esize (gnat_entity))
+ Set_Esize (gnat_entity, Esize (gnat_annotate_type));
+ if (Unknown_RM_Size (gnat_entity))
+ Set_RM_Size (gnat_entity, RM_Size (gnat_annotate_type));
}
/* If we haven't already, associate the ..._DECL node that we just made with
@@ -6900,6 +6912,7 @@ static tree
gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
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_field_type = Etype (gnat_field);
const bool is_atomic
@@ -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,
use the official RM size. See "Handling of Type'Size Values" in Einfo
for further details. */
- if (Known_Esize (gnat_field))
- gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
- gnat_field, FIELD_DECL, false, true);
+ if (Known_Esize (gnat_field) || Present (gnat_clause))
+ gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
+ FIELD_DECL, false, true);
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
gnu_size = NULL_TREE;
@@ -6972,7 +6988,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
&& (packed == 1
|| (gnu_size
&& (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))
% BITS_PER_UNIT == 0
&& 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,
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);
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
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,
tree gnu_var_name
= concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
"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;
bool union_field_needs_strict_alignment = false;
auto_vec <vinfo_t, 16> variant_types;
@@ -7593,9 +7608,6 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
unsigned int variants_align = 0;
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
are all in the variant part, to match the layout of C unions. There
is an associated check below. */
@@ -8831,10 +8843,6 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
if (uint_size == No_Uint)
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.
Otherwise, we'd be duplicating an error on the Size clause. */
gnat_attr_node
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index c2553d83ec82..35b71ef838ab 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -8567,7 +8567,8 @@ gnat_to_gnu (Node_Id gnat_node)
|| kind == N_Indexed_Component
|| kind == N_Selected_Component)
&& 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
= build_binary_op (NE_EXPR, gnu_result_type,