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) <E_Record_Type>: 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.

2 files changed, 53 insertions, 27 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e4892ee..769728a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,15 @@
 2020-05-25  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: 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  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_component_type): Cap the alignment
 	of the component type according to the component size.
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index ab6e79c..bd69c3a 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<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool);
-static vec<variant_desc> build_variant_list (tree, vec<subst_pair>,
+static vec<variant_desc> build_variant_list (tree, Node_Id, vec<subst_pair>,
 					     vec<variant_desc>);
 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<variant_desc>
-build_variant_list (tree qual_union_type, vec<subst_pair> subst_list,
-		    vec<variant_desc> gnu_list)
+build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part,
+		    vec<subst_pair> subst_list, vec<variant_desc> 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_pair> 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<subst_pair> gnu_subst_list,
+			       vec<subst_pair> 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.  */