From 036c83b68e7a958b75d02f392d0cb60f8b6a4ba5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 25 May 2020 10:15:12 +0200 Subject: [PATCH] Fix missing back-annotation for derived types Gigi fails to back-annotate the Present_Expr field of variants present in a type derived from a discriminated untagged record type, which is for example visible in the output -gnatRj. gcc/ada/ChangeLog * gcc-interface/decl.c (gnat_to_gnu_entity) : Tidy up. (build_variant_list): Add GNAT_VARIANT_PART parameter and annotate its variants if it is present. Adjust the recursive call by passing the variant subpart of variants, if any. (copy_and_substitute_in_layout): Rename GNU_SUBST_LIST to SUBST_LIST and adjust throughout. For a type, pass the variant part in the call to build_variant_list. --- gcc/ada/ChangeLog | 10 ++++++ gcc/ada/gcc-interface/decl.c | 70 ++++++++++++++++++++++-------------- 2 files changed, 53 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e4892ee5229..769728af854 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2020-05-25 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Tidy up. + (build_variant_list): Add GNAT_VARIANT_PART parameter and annotate its + variants if it is present. Adjust the recursive call by passing the + variant subpart of variants, if any. + (copy_and_substitute_in_layout): Rename GNU_SUBST_LIST to SUBST_LIST + and adjust throughout. For a type, pass the variant part in the + call to build_variant_list. + 2020-05-25 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_component_type): Cap the alignment diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ab6e79ce3c1..bd69c3ab306 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -230,7 +230,7 @@ static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); static tree build_position_list (tree, bool, tree, tree, unsigned int, tree); static vec build_subst_list (Entity_Id, Entity_Id, bool); -static vec build_variant_list (tree, vec, +static vec build_variant_list (tree, Node_Id, vec, vec); static tree maybe_saturate_size (tree); static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool, @@ -2992,15 +2992,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Record Types and Subtypes - The following fields are defined on record types: - - Has_Discriminants True if the record has discriminants - First_Discriminant Points to head of list of discriminants - First_Entity Points to head of list of fields - Is_Tagged_Type True if the record is tagged - - Implementation of Ada records and discriminated records: - A record type definition is transformed into the equivalent of a C struct definition. The fields that are the discriminants which are found in the Full_Type_Declaration node and the elements of the @@ -8886,20 +8877,29 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition) return gnu_list; } -/* Scan all fields in QUAL_UNION_TYPE and return a list describing the - variants of QUAL_UNION_TYPE that are still relevant after applying - the substitutions described in SUBST_LIST. GNU_LIST is a pre-existing +/* Scan all fields in {GNU_QUAL_UNION_TYPE,GNAT_VARIANT_PART} and return a list + describing the variants of GNU_QUAL_UNION_TYPE that are still relevant after + applying the substitutions described in SUBST_LIST. GNU_LIST is an existing list to be prepended to the newly created entries. */ static vec -build_variant_list (tree qual_union_type, vec subst_list, - vec gnu_list) +build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part, + vec subst_list, vec gnu_list) { + Node_Id gnat_variant; tree gnu_field; - for (gnu_field = TYPE_FIELDS (qual_union_type); + for (gnu_field = TYPE_FIELDS (gnu_qual_union_type), + gnat_variant + = Present (gnat_variant_part) + ? First_Non_Pragma (Variants (gnat_variant_part)) + : Empty; gnu_field; - gnu_field = DECL_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field), + gnat_variant + = Present (gnat_variant_part) + ? Next_Non_Pragma (gnat_variant) + : Empty) { tree qual = DECL_QUALIFIER (gnu_field); unsigned int i; @@ -8918,11 +8918,21 @@ build_variant_list (tree qual_union_type, vec subst_list, gnu_list.safe_push (v); + /* Annotate the GNAT node if present. */ + if (Present (gnat_variant)) + Set_Present_Expr (gnat_variant, annotate_value (qual)); + /* Recurse on the variant subpart of the variant, if any. */ variant_subpart = get_variant_part (variant_type); if (variant_subpart) - gnu_list = build_variant_list (TREE_TYPE (variant_subpart), - subst_list, gnu_list); + gnu_list + = build_variant_list (TREE_TYPE (variant_subpart), + Present (gnat_variant) + ? Variant_Part + (Component_List (gnat_variant)) + : Empty, + subst_list, + gnu_list); /* If the new qualifier is unconditionally true, the subsequent variants cannot be accessed. */ @@ -9806,7 +9816,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, Entity_Id gnat_old_type, tree gnu_new_type, tree gnu_old_type, - vec gnu_subst_list, + vec subst_list, bool debug_info_p) { const bool is_subtype = (Ekind (gnat_new_type) == E_Record_Subtype); @@ -9825,11 +9835,18 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, build a new qualified union for the variants that are still relevant. */ if (gnu_variant_part) { + const Node_Id gnat_decl = Declaration_Node (gnat_new_type); variant_desc *v; unsigned int i; - gnu_variant_list = build_variant_list (TREE_TYPE (gnu_variant_part), - gnu_subst_list, vNULL); + gnu_variant_list + = build_variant_list (TREE_TYPE (gnu_variant_part), + is_subtype + ? Empty + : Variant_Part + (Component_List (Type_Definition (gnat_decl))), + subst_list, + vNULL); /* If all the qualifiers are unconditionally true, the innermost variant is statically selected. */ @@ -9855,8 +9872,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, IDENTIFIER_POINTER (suffix)); TYPE_REVERSE_STORAGE_ORDER (new_variant) = TYPE_REVERSE_STORAGE_ORDER (gnu_new_type); - copy_and_substitute_in_size (new_variant, old_variant, - gnu_subst_list); + copy_and_substitute_in_size (new_variant, old_variant, subst_list); v->new_type = new_variant; } } @@ -9967,7 +9983,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, gnu_field = create_field_decl_from (gnu_old_field, gnu_field_type, gnu_cont_type, gnu_size, - gnu_pos_list, gnu_subst_list); + gnu_pos_list, subst_list); gnu_pos = DECL_FIELD_OFFSET (gnu_field); /* If the context is a variant, put it in the new variant directly. */ @@ -10054,13 +10070,13 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type, tree new_variant_part = create_variant_part_from (gnu_variant_part, gnu_variant_list, gnu_new_type, gnu_pos_list, - gnu_subst_list, debug_info_p); + subst_list, debug_info_p); DECL_CHAIN (new_variant_part) = gnu_field_list; gnu_field_list = new_variant_part; } gnu_variant_list.release (); - gnu_subst_list.release (); + subst_list.release (); /* If NEW_TYPE is a subtype, it inherits all the attributes from OLD_TYPE. Otherwise sizes and alignment must be computed independently. */ -- 2.30.2