This patch prevents expression functions which complete previous declarations
in a package spec from loading the body of the package spec on the basis that
the expression function body is needed for inlining. This in turn prevents the
generation of spurious dependencies on units in ALI files.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
2017-12-15 Hristian Kirtchev <kirtc...@adacore.com>
* inline.adb (Add_Inlined_Body): Do not add a function which is
completed by an expression function defined in the same context as the
initial declaration because the completing body is not in a package
body.
(Is_Non_Loading_Expression_Function): New routine.
gcc/testsuite/
2017-12-15 Hristian Kirtchev <kirtc...@adacore.com>
* gnat.dg/expr_func_main.adb, gnat.dg/expr_func_pkg.ads,
gnat.dg/expr_func_pkg.adb: New testcase.
Index: inline.adb
===================================================================
--- inline.adb (revision 255678)
+++ inline.adb (working copy)
@@ -298,10 +298,65 @@
-- Inline_Package means that the call is considered for inlining and
-- its package compiled and scanned for more inlining opportunities.
+ function Is_Non_Loading_Expression_Function
+ (Id : Entity_Id) return Boolean;
+ -- Determine whether arbitrary entity Id denotes a subprogram which is
+ -- either
+ --
+ -- * An expression function
+ --
+ -- * A function completed by an expression function where both the
+ -- spec and body are in the same context.
+
function Must_Inline return Inline_Level_Type;
-- Inlining is only done if the call statement N is in the main unit,
-- or within the body of another inlined subprogram.
+ ----------------------------------------
+ -- Is_Non_Loading_Expression_Function --
+ ----------------------------------------
+
+ function Is_Non_Loading_Expression_Function
+ (Id : Entity_Id) return Boolean
+ is
+ Body_Decl : Node_Id;
+ Body_Id : Entity_Id;
+ Spec_Decl : Node_Id;
+
+ begin
+ -- A stand-alone expression function is transformed into a spec-body
+ -- pair in-place. Since both the spec and body are in the same list,
+ -- the inlining of such an expression function does not need to load
+ -- anything extra.
+
+ if Is_Expression_Function (Id) then
+ return True;
+
+ -- A function may be completed by an expression function
+
+ elsif Ekind (Id) = E_Function then
+ Spec_Decl := Unit_Declaration_Node (Id);
+
+ if Nkind (Spec_Decl) = N_Subprogram_Declaration then
+ Body_Id := Corresponding_Body (Spec_Decl);
+
+ if Present (Body_Id) then
+ Body_Decl := Unit_Declaration_Node (Body_Id);
+
+ -- The inlining of a completing expression function does
+ -- not need to load anything extra when both the spec and
+ -- body are in the same context.
+
+ return
+ Was_Expression_Function (Body_Decl)
+ and then Parent (Spec_Decl) = Parent (Body_Decl);
+ end if;
+ end if;
+ end if;
+
+ return False;
+ end Is_Non_Loading_Expression_Function;
+
-----------------
-- Must_Inline --
-----------------
@@ -415,10 +470,12 @@
Set_Needs_Debug_Info (E, False);
end if;
- -- If the subprogram is an expression function, then there is no need to
- -- load any package body since the body of the function is in the spec.
+ -- If the subprogram is an expression function, or is completed by one
+ -- where both the spec and body are in the same context, then there is
+ -- no need to load any package body since the body of the function is
+ -- in the spec.
- if Is_Expression_Function (E) then
+ if Is_Non_Loading_Expression_Function (E) then
Set_Is_Called (E);
return;
end if;
Index: ../testsuite/gnat.dg/expr_func_main.adb
===================================================================
--- ../testsuite/gnat.dg/expr_func_main.adb (revision 0)
+++ ../testsuite/gnat.dg/expr_func_main.adb (revision 0)
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+
+with Expr_Func_Pkg; use Expr_Func_Pkg;
+
+procedure Expr_Func_Main is
+ Val : Boolean := Expr_Func (456);
+begin
+ null;
+end Expr_Func_Main;
Index: ../testsuite/gnat.dg/expr_func_pkg.adb
===================================================================
--- ../testsuite/gnat.dg/expr_func_pkg.adb (revision 0)
+++ ../testsuite/gnat.dg/expr_func_pkg.adb (revision 0)
@@ -0,0 +1,7 @@
+package body Expr_Func_Pkg is
+ function Func (Val : Integer) return Boolean is
+ begin
+ Error; -- { dg-error "\"Error\" is undefined" }
+ return Val = 123;
+ end Func;
+end Expr_Func_Pkg;
Index: ../testsuite/gnat.dg/expr_func_pkg.ads
===================================================================
--- ../testsuite/gnat.dg/expr_func_pkg.ads (revision 0)
+++ ../testsuite/gnat.dg/expr_func_pkg.ads (revision 0)
@@ -0,0 +1,6 @@
+package Expr_Func_Pkg is
+ function Func (Val : Integer) return Boolean with Inline;
+
+ function Expr_Func (Val : Integer) return Boolean;
+ function Expr_Func (Val : Integer) return Boolean is (True);
+end Expr_Func_Pkg;
