From abbc45464b1be9895a4842903a5c75b6dd085b9a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 8 Jul 2019 08:13:30 +0000 Subject: [PATCH] [Ada] Fix crash on extension of private type with -gnatRj This fixes a crash (or an assertion failure) during the processing done for -gnatRj on the declaration of an extension of a private type. Generally speaking, extension declarations are delicate in this context because the front-end does not duplicate the structure of the parent type, so the processing required to output the structural layout needs to go up to the declaration of the parent type, which may or may not be available or usable. The change also makes the processing more robust by falling back to the flat layout if the declaration of the parent type cannot be processed. 2019-07-08 Eric Botcazou gcc/ada/ * repinfo.adb (List_Record_Info): Declare Incomplete_Layout and Not_In_Extended_Main local exceptions. (List_Structural_Record_Layout): For an extension, raise the former if the parent subtype has not been built and the latter if it is not declared in the main source unit. Fall back to the flat layout if either exception has been raised. From-SVN: r273206 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/repinfo.adb | 42 +++++++++++++++++++++++++++++++++++++++--- 2 files changed, 48 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f97ab9ea4e..198db54e7a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-07-08 Eric Botcazou + + * repinfo.adb (List_Record_Info): Declare Incomplete_Layout and + Not_In_Extended_Main local exceptions. + (List_Structural_Record_Layout): For an extension, raise the + former if the parent subtype has not been built and the latter + if it is not declared in the main source unit. Fall back to the + flat layout if either exception has been raised. + 2019-07-08 Ed Schonberg * libgnat/a-strfix.adb (Delete): The RM describes the semantics diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 007fe39c422..4bf33516468 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1125,6 +1125,12 @@ package body Repinfo is Indent : Natural := 0); -- Internal recursive procedure to display the structural layout + Incomplete_Layout : exception; + -- Exception raised if the layout is incomplete in -gnatc mode + + Not_In_Extended_Main : exception; + -- Exception raised when an ancestor is not declared in the main unit + Max_Name_Length : Natural := 0; Max_Spos_Length : Natural := 0; @@ -1564,14 +1570,29 @@ package body Repinfo is Disc : Entity_Id; Listed_Disc : Entity_Id; + Parent_Type : Entity_Id; begin -- If this is an extension, first list the layout of the parent -- and then proceed to the extension part, if any. if Is_Extension then - List_Structural_Record_Layout - (Base_Type (Parent_Subtype (Ent)), Outer_Ent); + Parent_Type := Parent_Subtype (Ent); + if No (Parent_Type) then + raise Incomplete_Layout; + end if; + + if Is_Private_Type (Parent_Type) then + Parent_Type := Full_View (Parent_Type); + 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; + end if; + + List_Structural_Record_Layout (Parent_Type, Outer_Ent); First := False; if Present (Record_Extension_Part (Definition)) then @@ -1733,8 +1754,23 @@ package body Repinfo is Write_Line (","); Write_Str (" ""record"": ["); + -- ??? We can output structural layout only for base types fully + -- declared in the extended main source unit for the time being, + -- because otherwise declarations might not be processed at all. + if Is_Base_Type (Ent) then - List_Structural_Record_Layout (Ent, Ent); + begin + List_Structural_Record_Layout (Ent, Ent); + + exception + when Incomplete_Layout + | Not_In_Extended_Main + => + List_Record_Layout (Ent); + + when others => + raise Program_Error; + end; else List_Record_Layout (Ent); end if; -- 2.30.2