public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2207] [Ada] Fix invalid JSON for derived variant record with -gnatRj Date: Fri, 9 Jul 2021 12:39:08 +0000 (GMT) [thread overview] Message-ID: <20210709123908.CA405398B0EA@sourceware.org> (raw) https://gcc.gnu.org/g:2390451ede49fa09bc0d9692802651aff66ae8a6 commit r12-2207-g2390451ede49fa09bc0d9692802651aff66ae8a6 Author: Eric Botcazou <ebotcazou@adacore.com> Date: Fri Jun 11 09:11:13 2021 +0200 [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. Diff: --- gcc/ada/repinfo.adb | 55 ++++++++++++++++++++++++++++++++++++++--------------- gcc/ada/repinfo.ads | 7 ++++--- 2 files changed, 44 insertions(+), 18 deletions(-) diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 3cc1f939a32..25b52376905 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 45eb0abf584..606bba45cd1 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.
reply other threads:[~2021-07-09 12:39 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20210709123908.CA405398B0EA@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).