From d71e9fb2a5f1d55a065e3b50ee5fb2a34e75ead7 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Aug 2019 08:06:39 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 13 ++++++++++ gcc/ada/exp_ch6.adb | 11 ++++---- gcc/ada/sem_ch12.adb | 31 +++++++++++------------ gcc/testsuite/ChangeLog | 6 +++++ gcc/testsuite/gnat.dg/generic_inst8.adb | 8 ++++++ gcc/testsuite/gnat.dg/generic_inst8.ads | 7 +++++ gcc/testsuite/gnat.dg/generic_inst8_g.adb | 12 +++++++++ gcc/testsuite/gnat.dg/generic_inst8_g.ads | 17 +++++++++++++ 8 files changed, 84 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/generic_inst8.adb create mode 100644 gcc/testsuite/gnat.dg/generic_inst8.ads create mode 100644 gcc/testsuite/gnat.dg/generic_inst8_g.adb create mode 100644 gcc/testsuite/gnat.dg/generic_inst8_g.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0c34ee8663c..2b0f272e44d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-08-13 Eric Botcazou + + * 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 * exp_disp.adb (Make_Secondary_DT): Handle record type diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8d5a70dbe97..4fd38605e63 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1f3a397e6e4..8b031b529ae 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 265d991154f..206d39d1c72 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-08-13 Eric Botcazou + + * 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 * gnat.dg/tag2.adb, gnat.dg/tag2_pkg.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/generic_inst8.adb b/gcc/testsuite/gnat.dg/generic_inst8.adb new file mode 100644 index 00000000000..5536f0b67ec --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/generic_inst8.ads b/gcc/testsuite/gnat.dg/generic_inst8.ads new file mode 100644 index 00000000000..d6491e352e5 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/generic_inst8_g.adb b/gcc/testsuite/gnat.dg/generic_inst8_g.adb new file mode 100644 index 00000000000..dab7b6256b6 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/generic_inst8_g.ads b/gcc/testsuite/gnat.dg/generic_inst8_g.ads new file mode 100644 index 00000000000..087a9e66d20 --- /dev/null +++ b/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; -- 2.30.2