Commit 6c87c83b by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Lift restriction on instantiations that are compilation units

This change lifts the restriction that was still present in the new
on-demand instantiation scheme for the body of generics instantiated in
non-main units.

The instantiations that are compilation units were still dealt with in
the old-fashioned way, that is to say the decision of instantiating the
body was still made up front during the analysis of the instance
declaration, instead of being deferred until after a call to an inlined
subprogram is encountered.

This should save a few more cycles when full inlining across units is
enabled, but there should otherwise be no functional changes.

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

gcc/ada/

	* inline.adb (Add_Inlined_Body): Do not special-case instances
	that are compilation units.
	(Add_Pending_Instantiation): Likewise.
	(Instantiate_Body): Skip instantiations that are compilation
	units and have already been performed.
	* sem_ch12.adb (Needs_Body_Instantiated): Do not special-case
	instances that are compilation units.
	(Load_Parent_Of_Generic): Be prepared for parent that is a
	compilation unit but whose instantiation node has not been
	replaced.

gcc/testsuite/

	* gnat.dg/generic_inst12.adb, gnat.dg/generic_inst12_pkg1.adb,
	gnat.dg/generic_inst12_pkg1.ads,
	gnat.dg/generic_inst12_pkg2.ads: New testcase.

From-SVN: r274657
parent 92b635e5
2019-08-19 Eric Botcazou <ebotcazou@adacore.com> 2019-08-19 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Add_Inlined_Body): Do not special-case instances
that are compilation units.
(Add_Pending_Instantiation): Likewise.
(Instantiate_Body): Skip instantiations that are compilation
units and have already been performed.
* sem_ch12.adb (Needs_Body_Instantiated): Do not special-case
instances that are compilation units.
(Load_Parent_Of_Generic): Be prepared for parent that is a
compilation unit but whose instantiation node has not been
replaced.
2019-08-19 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Initialize, Lock): Deal with * inline.adb (Initialize, Lock): Deal with
Called_Pending_Instantiations. Called_Pending_Instantiations.
......
...@@ -611,12 +611,11 @@ package body Inline is ...@@ -611,12 +611,11 @@ package body Inline is
Inst_Decl := Unit_Declaration_Node (Inst); Inst_Decl := Unit_Declaration_Node (Inst);
-- Do not inline the instance if the body already exists, -- Do not inline the instance if the body already exists,
-- or if the instance is a compilation unit, or else if -- or the instance node is simply missing.
-- the instance node is simply missing.
if Present (Corresponding_Body (Inst_Decl)) if Present (Corresponding_Body (Inst_Decl))
or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit or else (Nkind (Parent (Inst_Decl)) /= N_Compilation_Unit
or else No (Next (Inst_Decl)) and then No (Next (Inst_Decl)))
then then
Set_Is_Called (Inst); Set_Is_Called (Inst);
else else
...@@ -797,13 +796,11 @@ package body Inline is ...@@ -797,13 +796,11 @@ package body Inline is
To_Pending_Instantiations.Set (Act_Decl, Index); To_Pending_Instantiations.Set (Act_Decl, Index);
-- If an instantiation is either a compilation unit or is in the main -- If an instantiation is in the main unit or subunit, or is a nested
-- unit or subunit or is a nested subprogram, then its body is needed -- subprogram, then its body is needed as per the analysis done in
-- as per the analysis already done in Analyze_Package_Instantiation -- Analyze_Package_Instantiation & Analyze_Subprogram_Instantiation.
-- and Analyze_Subprogram_Instantiation.
if Nkind (Parent (Inst)) = N_Compilation_Unit if In_Main_Unit_Or_Subunit (Act_Decl_Id)
or else In_Main_Unit_Or_Subunit (Act_Decl_Id)
or else (Is_Subprogram (Act_Decl_Id) or else (Is_Subprogram (Act_Decl_Id)
and then Is_Nested (Act_Decl_Id)) and then Is_Nested (Act_Decl_Id))
then then
...@@ -4460,6 +4457,13 @@ package body Inline is ...@@ -4460,6 +4457,13 @@ package body Inline is
if No (Info.Inst_Node) then if No (Info.Inst_Node) then
null; null;
-- If the instantiation node is a package body, this means that the
-- instance is a compilation unit and the instantiation has already
-- been performed by Build_Instance_Compilation_Unit_Nodes.
elsif Nkind (Info.Inst_Node) = N_Package_Body then
null;
elsif Nkind (Info.Act_Decl) = N_Package_Declaration then elsif Nkind (Info.Act_Decl) = N_Package_Declaration then
Instantiate_Package_Body (Info); Instantiate_Package_Body (Info);
Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));
......
...@@ -3921,19 +3921,15 @@ package body Sem_Ch12 is ...@@ -3921,19 +3921,15 @@ package body Sem_Ch12 is
return False; return False;
end if; end if;
-- Here we have a special handling for back-end inlining: if the -- Here we have a special handling for back-end inlining: if inline
-- instantiation is not a compilation unit, then we want to have -- processing is required, then we unconditionally want to have the
-- its body instantiated. The reason is that Might_Inline_Subp -- body instantiated. The reason is that Might_Inline_Subp does not
-- does not catch all the cases (since it does not recurse into -- catch all the cases (as it does not recurse into nested packages)
-- nested packages) so this avoids the need to patch things up -- so this avoids the need to patch things up afterwards. Moreover,
-- at a later stage. Moreover the instantiations that are not -- these instantiations are only performed on demand when back-end
-- compilation units are only performed on demand when back-end
-- inlining is enabled, so this causes very little extra work. -- inlining is enabled, so this causes very little extra work.
if Nkind (Parent (N)) /= N_Compilation_Unit if Inline_Processing_Required and then Back_End_Inlining then
and then Inline_Processing_Required
and then Back_End_Inlining
then
return True; return True;
end if; end if;
...@@ -13699,15 +13695,26 @@ package body Sem_Ch12 is ...@@ -13699,15 +13695,26 @@ package body Sem_Ch12 is
and then and then
Nkind (Original_Node (True_Parent)) = N_Package_Instantiation Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
then then
-- Parent is a compilation unit that is an instantiation. -- Parent is a compilation unit that is an instantiation, and
-- Instantiation node has been replaced with package decl. -- instantiation node has been replaced with package decl.
Inst_Node := Original_Node (True_Parent); Inst_Node := Original_Node (True_Parent);
exit; exit;
elsif Nkind (True_Parent) = N_Package_Declaration elsif Nkind (True_Parent) = N_Package_Declaration
and then Present (Generic_Parent (Specification (True_Parent))) and then Nkind (Parent (True_Parent)) = N_Compilation_Unit
and then
Nkind (Unit (Parent (True_Parent))) = N_Package_Instantiation
then
-- Parent is a compilation unit that is an instantiation, but
-- instantiation node has not been replaced with package decl.
Inst_Node := Unit (Parent (True_Parent));
exit;
elsif Nkind (True_Parent) = N_Package_Declaration
and then Nkind (Parent (True_Parent)) /= N_Compilation_Unit and then Nkind (Parent (True_Parent)) /= N_Compilation_Unit
and then Present (Generic_Parent (Specification (True_Parent)))
then then
-- Parent is an instantiation within another specification. -- Parent is an instantiation within another specification.
-- Declaration for instance has been inserted before original -- Declaration for instance has been inserted before original
......
2019-08-19 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/generic_inst12.adb, gnat.dg/generic_inst12_pkg1.adb,
gnat.dg/generic_inst12_pkg1.ads,
gnat.dg/generic_inst12_pkg2.ads: New testcase.
2019-08-19 Ed Schonberg <schonberg@adacore.com> 2019-08-19 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/warn28.adb, gnat.dg/warn28.ads: New testcase. * gnat.dg/warn28.adb, gnat.dg/warn28.ads: New testcase.
......
-- { dg-do run }
-- { dg-options "-O -gnatn" }
with Generic_Inst12_Pkg2;
procedure Generic_Inst12 is
procedure My_Inner_G is new Generic_Inst12_Pkg2.Inner_G;
begin
My_Inner_G (1);
Generic_Inst12_Pkg2.Proc (1);
end;
package body Generic_Inst12_Pkg1 is
procedure Inner_G (Val : T) is
begin
null;
end;
procedure Proc (Val : T) is
begin
null;
end;
end Generic_Inst12_Pkg1;
generic
type T is private;
package Generic_Inst12_Pkg1 is
generic
procedure Inner_G (Val : T);
procedure Proc (Val : T);
pragma Inline (Proc);
end Generic_Inst12_Pkg1;
with Generic_Inst12_Pkg1;
package Generic_Inst12_Pkg2 is new Generic_Inst12_Pkg1 (Integer);
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