diff mbox series

[Ada] Lift restriction on instantiations that are compilation units

Message ID 20190819083901.GA33498@adacore.com
State New
Headers show
Series [Ada] Lift restriction on instantiations that are compilation units | expand

Commit Message

Pierre-Marie de Rodat Aug. 19, 2019, 8:39 a.m. UTC
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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox series

Patch

--- gcc/ada/inline.adb
+++ gcc/ada/inline.adb
@@ -611,12 +611,11 @@  package body Inline is
                   Inst_Decl := Unit_Declaration_Node (Inst);
 
                   --  Do not inline the instance if the body already exists,
-                  --  or if the instance is a compilation unit, or else if
-                  --  the instance node is simply missing.
+                  --  or the instance node is simply missing.
 
                   if Present (Corresponding_Body (Inst_Decl))
-                    or else Nkind (Parent (Inst_Decl)) = N_Compilation_Unit
-                    or else No (Next (Inst_Decl))
+                    or else (Nkind (Parent (Inst_Decl)) /= N_Compilation_Unit
+                              and then No (Next (Inst_Decl)))
                   then
                      Set_Is_Called (Inst);
                   else
@@ -797,13 +796,11 @@  package body Inline is
 
          To_Pending_Instantiations.Set (Act_Decl, Index);
 
-         --  If an instantiation is either a compilation unit or is in the main
-         --  unit or subunit or is a nested subprogram, then its body is needed
-         --  as per the analysis already done in Analyze_Package_Instantiation
-         --  and Analyze_Subprogram_Instantiation.
+         --  If an instantiation is in the main unit or subunit, or is a nested
+         --  subprogram, then its body is needed as per the analysis done in
+         --  Analyze_Package_Instantiation & Analyze_Subprogram_Instantiation.
 
-         if Nkind (Parent (Inst)) = N_Compilation_Unit
-           or else In_Main_Unit_Or_Subunit (Act_Decl_Id)
+         if In_Main_Unit_Or_Subunit (Act_Decl_Id)
            or else (Is_Subprogram (Act_Decl_Id)
                      and then Is_Nested (Act_Decl_Id))
          then
@@ -4460,6 +4457,13 @@  package body Inline is
          if No (Info.Inst_Node) then
             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
             Instantiate_Package_Body (Info);
             Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl));

--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -3921,19 +3921,15 @@  package body Sem_Ch12 is
             return False;
          end if;
 
-         --  Here we have a special handling for back-end inlining: if the
-         --  instantiation is not a compilation unit, then we want to have
-         --  its body instantiated. The reason is that Might_Inline_Subp
-         --  does not catch all the cases (since it does not recurse into
-         --  nested packages) so this avoids the need to patch things up
-         --  at a later stage. Moreover the instantiations that are not
-         --  compilation units are only performed on demand when back-end
+         --  Here we have a special handling for back-end inlining: if inline
+         --  processing is required, then we unconditionally want to have the
+         --  body instantiated. The reason is that Might_Inline_Subp does not
+         --  catch all the cases (as it does not recurse into nested packages)
+         --  so this avoids the need to patch things up afterwards. Moreover,
+         --  these instantiations are only performed on demand when back-end
          --  inlining is enabled, so this causes very little extra work.
 
-         if Nkind (Parent (N)) /= N_Compilation_Unit
-           and then Inline_Processing_Required
-           and then Back_End_Inlining
-         then
+         if Inline_Processing_Required and then Back_End_Inlining then
             return True;
          end if;
 
@@ -13699,15 +13695,26 @@  package body Sem_Ch12 is
               and then
                 Nkind (Original_Node (True_Parent)) = N_Package_Instantiation
             then
-               --  Parent is a compilation unit that is an instantiation.
-               --  Instantiation node has been replaced with package decl.
+               --  Parent is a compilation unit that is an instantiation, and
+               --  instantiation node has been replaced with package decl.
 
                Inst_Node := Original_Node (True_Parent);
                exit;
 
             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 Present (Generic_Parent (Specification (True_Parent)))
             then
                --  Parent is an instantiation within another specification.
                --  Declaration for instance has been inserted before original

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst12.adb
@@ -0,0 +1,12 @@ 
+--  { 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;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst12_pkg1.adb
@@ -0,0 +1,13 @@ 
+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;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst12_pkg1.ads
@@ -0,0 +1,11 @@ 
+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;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/generic_inst12_pkg2.ads
@@ -0,0 +1,3 @@ 
+with Generic_Inst12_Pkg1;
+
+package Generic_Inst12_Pkg2 is new Generic_Inst12_Pkg1 (Integer);