Commit abbc4546 by Eric Botcazou Committed by Pierre-Marie de Rodat

[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  <ebotcazou@adacore.com>

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
parent 4962dc44
2019-07-08 Eric Botcazou <ebotcazou@adacore.com>
* 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 <schonberg@adacore.com>
* libgnat/a-strfix.adb (Delete): The RM describes the semantics
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment