[Ada] Fix invalid JSON for derived variant record with -gnatRj

gcc/ada/

	* repinfo.ads (JSON output format): Document adjusted key name.
	* repinfo.adb (List_Record_Layout): Use Original_Record_Component
	if the normalized position of the component is not known.
	(List_Structural_Record_Layout): Rename Outer_Ent parameter into
	Ext_End and add Ext_Level parameter. In an extension, if the parent
	subtype has static discriminants, call List_Record_Layout on it.
	Output "parent_" prefixes before "variant" according to Ext_Level.
	Adjust recursive calls throughout the procedure.

2 files changed, 44 insertions, 18 deletions

diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index 3cc1f93..25b5237 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -963,10 +963,15 @@ package body Repinfo is
 
       procedure List_Structural_Record_Layout
         (Ent       : Entity_Id;
-         Outer_Ent : Entity_Id;
+         Ext_Ent   : Entity_Id;
+         Ext_Level : Nat := 0;
          Variant   : Node_Id := Empty;
          Indent    : Natural := 0);
-      --  Internal recursive procedure to display the structural layout
+      --  Internal recursive procedure to display the structural layout.
+      --  If Ext_Ent is not equal to Ent, it is an extension of Ent and
+      --  Ext_Level is the number of successive extensions between them.
+      --  If Variant is present, it's for a variant in the variant part
+      --  instead of the common part of Ent. Indent is the indentation.
 
       Incomplete_Layout : exception;
       --  Exception raised if the layout is incomplete in -gnatc mode
@@ -1319,7 +1324,12 @@ package body Repinfo is
                   end if;
                end if;
 
-               List_Component_Layout (Comp,
+               --  The Parent_Subtype in an extension is not back-annotated
+
+               List_Component_Layout (
+                 (if Known_Normalized_Position (Comp)
+                  then Comp
+                  else Original_Record_Component (Comp)),
                  Starting_Position, Starting_First_Bit, Prefix);
             end;
 
@@ -1334,15 +1344,16 @@ package body Repinfo is
 
       procedure List_Structural_Record_Layout
         (Ent       : Entity_Id;
-         Outer_Ent : Entity_Id;
+         Ext_Ent   : Entity_Id;
+         Ext_Level : Nat := 0;
          Variant   : Node_Id := Empty;
          Indent    : Natural := 0)
       is
          function Derived_Discriminant (Disc : Entity_Id) return Entity_Id;
-         --  This function assumes that Outer_Ent is an extension of Ent.
+         --  This function assumes that Ext_Ent is an extension of Ent.
          --  Disc is a discriminant of Ent that does not itself constrain a
          --  discriminant of the parent type of Ent. Return the discriminant
-         --  of Outer_Ent that ultimately constrains Disc, if any.
+         --  of Ext_Ent that ultimately constrains Disc, if any.
 
          ----------------------------
          --  Derived_Discriminant  --
@@ -1353,7 +1364,7 @@ package body Repinfo is
             Derived_Disc : Entity_Id;
 
          begin
-            Derived_Disc := First_Discriminant (Outer_Ent);
+            Derived_Disc := First_Discriminant (Ext_Ent);
 
             --  Loop over the discriminants of the extension
 
@@ -1380,7 +1391,7 @@ package body Repinfo is
                Next_Discriminant (Derived_Disc);
             end loop;
 
-            --  Disc is not constrained by a discriminant of Outer_Ent
+            --  Disc is not constrained by a discriminant of Ext_Ent
 
             return Empty;
          end Derived_Discriminant;
@@ -1432,12 +1443,21 @@ package body Repinfo is
                      pragma Assert (Present (Parent_Type));
                   end if;
 
-                  Parent_Type := Base_Type (Parent_Type);
-                  if not In_Extended_Main_Source_Unit (Parent_Type) then
-                     raise Not_In_Extended_Main;
+                  --  Do not list variants if one of them has been selected
+
+                  if Has_Static_Discriminants (Parent_Type) then
+                     List_Record_Layout (Parent_Type);
+
+                  else
+                     Parent_Type := Base_Type (Parent_Type);
+                     if not In_Extended_Main_Source_Unit (Parent_Type) then
+                        raise Not_In_Extended_Main;
+                     end if;
+
+                     List_Structural_Record_Layout
+                       (Parent_Type, Ext_Ent, Ext_Level + 1);
                   end if;
 
-                  List_Structural_Record_Layout (Parent_Type, Outer_Ent);
                   First := False;
 
                   if Present (Record_Extension_Part (Definition)) then
@@ -1467,7 +1487,7 @@ package body Repinfo is
                      --  If this is the parent type of an extension, retrieve
                      --  the derived discriminant from the extension, if any.
 
-                     if Ent /= Outer_Ent then
+                     if Ent /= Ext_Ent then
                         Listed_Disc := Derived_Discriminant (Disc);
 
                         if No (Listed_Disc) then
@@ -1544,7 +1564,11 @@ package body Repinfo is
          Spaces (Indent);
          Write_Line ("  ],");
          Spaces (Indent);
-         Write_Str ("  ""variant"" : [");
+         Write_Str ("  """);
+         for J in 1 .. Ext_Level loop
+            Write_Str ("parent_");
+         end loop;
+         Write_Str ("variant"" : [");
 
          --  Otherwise we recurse on each variant
 
@@ -1567,7 +1591,8 @@ package body Repinfo is
             Spaces (Indent);
             Write_Str ("      ""record"": [");
 
-            List_Structural_Record_Layout (Ent, Outer_Ent, Var, Indent + 4);
+            List_Structural_Record_Layout
+              (Ent, Ext_Ent, Ext_Level, Var, Indent + 4);
 
             Write_Eol;
             Spaces (Indent);
diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads
index 45eb0ab..606bba4 100644
--- a/gcc/ada/repinfo.ads
+++ b/gcc/ada/repinfo.ads
@@ -189,7 +189,7 @@ package Repinfo is
    --    "name"                 :  string
    --    "location"             :  string
    --    "record"               :  array of components
-   --    "variant"              :  array of variants
+   --    "[parent_]*variant"    :  array of variants
    --    "formal"               :  array of formal parameters
    --    "mechanism"            :  string
    --    "Size"                 :  numerical expression
@@ -209,8 +209,9 @@ package Repinfo is
    --    fully qualified Ada name. The value of "location" is the expanded
    --    chain of instantiation locations that contains the entity.
    --    "record" is present for every record type and its value is the list of
-   --    components. "variant" is present only if the record type has a variant
-   --    part and its value is the list of variants.
+   --    components. "[parent_]*variant" is present only if the record type, or
+   --    one of its ancestors (parent, grand-parent, etc) if it's an extension,
+   --    has a variant part and its value is the list of variants.
    --    "formal" is present for every subprogram and entry, and its value is
    --    the list of formal parameters. "mechanism" is present for functions
    --    only and its value is the return mechanim.