From f2bee2395180f0e45177ccdd92dca8f327679e46 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 11 Dec 2018 11:11:47 +0000 Subject: [PATCH] [Ada] Fix -gnatR3 output for dynamically constrained record 2018-12-11 Eric Botcazou gcc/ada/ * gcc-interface/decl.c (gnat_to_gnu_entity): Add gnat_annotate_type local variable initialized to Empty. : 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 d9dfb22..1fd528c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2018-12-11 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity): Add + gnat_annotate_type local variable initialized to Empty. + : 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 * 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 eaa1a52..b2f9229 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 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 c2553d8..35b71ef 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, -- 2.7.4