[Ada] Fix spurious error on nested instantiation with inlining

This prevents the compiler from issuing a spurious error in a convoluted
case where a child generic package declared in an enclosing parent
generic package, which contains a second child generic package, contains
an inlined subprogram and the second child generic package contains an
instantiation of the first, and the enclosing parent generic package is
instantiated with inlining across units enabled (-gnatn[12]).

The problem is that the compiler attempts to instantiate the body of the
first child generic package in the context of the enclosing parent
generic package, instead of doing it in the context of the instantiation
of the parent generic package, because of the presence of the inlined
subprogram.

2019-08-13  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch6.adb (Expand_Call_Helper): If back-end inlining is
	enabled, also instantiate the body of a generic unit containing
	a subprogram subject to aspect/pragma Inline_Always at
	optimization level zero.
	* sem_ch12.adb (Might_Inline_Subp): Minor tweak.
	(Analyze_Package_Instantiation): Do not instantiate the package
	body because of inlining considerations if the instantiation is
	done in a generic unit.  Move around similar condition involving
	the main unit.  Add test on Back_End_Inlining to processing for
	front-end inlining.

gcc/testsuite/

	* gnat.dg/generic_inst8.adb, gnat.dg/generic_inst8.ads,
	gnat.dg/generic_inst8_g.adb, gnat.dg/generic_inst8_g.ads: New
	testcase.

From-SVN: r274336
This commit is contained in:
Eric Botcazou 2019-08-13 08:06:39 +00:00 committed by Pierre-Marie de Rodat
parent 7225a47971
commit d71e9fb2a5
8 changed files with 84 additions and 21 deletions

View File

@ -1,3 +1,16 @@
2019-08-13 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch6.adb (Expand_Call_Helper): If back-end inlining is
enabled, also instantiate the body of a generic unit containing
a subprogram subject to aspect/pragma Inline_Always at
optimization level zero.
* sem_ch12.adb (Might_Inline_Subp): Minor tweak.
(Analyze_Package_Instantiation): Do not instantiate the package
body because of inlining considerations if the instantiation is
done in a generic unit. Move around similar condition involving
the main unit. Add test on Back_End_Inlining to processing for
front-end inlining.
2019-08-13 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Make_Secondary_DT): Handle record type

View File

@ -4431,14 +4431,15 @@ package body Exp_Ch6 is
then
Add_Inlined_Body (Subp, Call_Node);
-- If the inlined call appears within an instantiation and some
-- level of optimization is required, ensure that the enclosing
-- instance body is available so that the back-end can actually
-- perform the inlining.
-- If the inlined call appears within an instantiation and either
-- is required to be inlined or optimization is enabled, ensure
-- that the enclosing instance body is available so the back end
-- can actually perform the inlining.
if In_Instance
and then Comes_From_Source (Subp)
and then Optimization_Level > 0
and then (Has_Pragma_Inline_Always (Subp)
or else Optimization_Level > 0)
then
declare
Decl : Node_Id;

View File

@ -3895,10 +3895,7 @@ package body Sem_Ch12 is
E : Entity_Id;
begin
if not Inline_Processing_Required then
return False;
else
if Inline_Processing_Required then
E := First_Entity (Gen_Unit);
while Present (E) loop
if Is_Subprogram (E) and then Is_Inlined (E) then
@ -4281,12 +4278,13 @@ package body Sem_Ch12 is
end if;
end if;
-- Save the instantiation node, for subsequent instantiation of the
-- body, if there is one and we are generating code for the current
-- unit. Mark unit as having a body (avoids premature error message).
-- Save the instantiation node for a subsequent instantiation of the
-- body if there is one and the main unit is not generic, and either
-- we are generating code for this main unit, or the instantiation
-- contains inlined subprograms and is not done in a generic unit.
-- We instantiate the body if we are generating code, if we are
-- generating cross-reference information, or if we are building
-- We instantiate the body only if we are generating code, or if we
-- are generating cross-reference information, or if we are building
-- trees for ASIS use or GNATprove use.
declare
@ -4379,14 +4377,15 @@ package body Sem_Ch12 is
(Unit_Requires_Body (Gen_Unit)
or else Enclosing_Body_Present
or else Present (Corresponding_Body (Gen_Decl)))
and then not Is_Generic_Unit (Cunit_Entity (Main_Unit))
and then (Is_In_Main_Unit (N)
or else Might_Inline_Subp (Gen_Unit))
or else (Might_Inline_Subp (Gen_Unit)
and then
not Is_Generic_Unit
(Cunit_Entity (Get_Code_Unit (N)))))
and then not Is_Actual_Pack
and then not Inline_Now
and then (Operating_Mode = Generate_Code
-- Need comment for this check ???
or else (Operating_Mode = Check_Semantics
and then (ASIS_Mode or GNATprove_Mode)));
@ -4394,9 +4393,9 @@ package body Sem_Ch12 is
-- marked with Inline_Always, do not instantiate body when within
-- a generic context.
if ((Front_End_Inlining or else Has_Inline_Always)
and then not Expander_Active)
or else Is_Generic_Unit (Cunit_Entity (Main_Unit))
if not Back_End_Inlining
and then (Front_End_Inlining or else Has_Inline_Always)
and then not Expander_Active
then
Needs_Body := False;
end if;

View File

@ -1,3 +1,9 @@
2019-08-13 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/generic_inst8.adb, gnat.dg/generic_inst8.ads,
gnat.dg/generic_inst8_g.adb, gnat.dg/generic_inst8_g.ads: New
testcase.
2019-08-13 Javier Miranda <miranda@adacore.com>
* gnat.dg/tag2.adb, gnat.dg/tag2_pkg.ads: New testcase.

View File

@ -0,0 +1,8 @@
-- { dg-do compile }
-- { dg-options "-gnatn" }
package body Generic_Inst8 is
package My_G is new Generic_Inst8_G (0);
end Generic_Inst8;

View File

@ -0,0 +1,7 @@
with Generic_Inst8_G;
package Generic_Inst8 is
pragma Elaborate_Body;
end Generic_Inst8;

View File

@ -0,0 +1,12 @@
package body Generic_Inst8_G is
package body First is
function Get (Data : T) return T is
begin
return Data;
end;
end First;
end Generic_Inst8_G;

View File

@ -0,0 +1,17 @@
generic
N : Natural;
package Generic_Inst8_G is
generic
type T is private;
package First is
function Get (Data : T) return T with Inline;
end First;
generic
type T is private;
package Second is
package My_First is new First (T);
end Second;
end Generic_Inst8_G;