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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-13 Eric Botcazou <ebotca...@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.--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -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;
--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst8.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst8.ads
@@ -0,0 +1,7 @@
+with Generic_Inst8_G;
+
+package Generic_Inst8 is
+
+ pragma Elaborate_Body;
+
+end Generic_Inst8;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst8_g.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst8_g.ads
@@ -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;
