> 2014-10-31 Eric Botcazou <ebotca...@adacore.com>
>
> * inline.adb (Has_Excluded_Declaration): With back-end inlining,
> only return true for nested packages.
> (Cannot_Inline): Issue errors/warnings whatever the optimization level
> for back-end inlining and remove assertion.
Here is a follow-up patch for the case of nested subprograms, as well as a
bunch of testcases for the gnat.dg testsuite.
Tested on x86_64-suse-linux, applied on the mainline.
2014-11-05 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/utils.c (create_subprog_decl): Move code dealing with
conflicting inlining status of nested subprograms to...
* gcc-interface/trans.c (check_inlining_for_nested_subprog): ...here.
(Attribute_to_gnu) <Attr_Access>: Call it.
(Call_to_gnu): Likewise.
(Subprogram_Body_to_gnu): Drop the body if it is an inlined external
function that has been marked uninlinable.
2014-11-05 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/inline1.adb: New test.
* gnat.dg/inline1_pkg.ad[sb]: New helper.
* gnat.dg/inline2.adb: New test.
* gnat.dg/inline2_pkg.ad[sb]: New helper.
* gnat.dg/inline3.adb: New test.
* gnat.dg/inline3_pkg.ad[sb]: New helper.
* gnat.dg/inline4.adb: New test.
* gnat.dg/inline4_pkg.ad[sb]: New helper.
* gnat.dg/inline5.adb: New test.
* gnat.dg/inline5_pkg.ad[sb]: New helper.
* gnat.dg/inline6.adb: New test.
* gnat.dg/inline6_pkg.ad[sb]: New helper.
* gnat.dg/inline7.adb: New test.
* gnat.dg/inline7_pkg1.ad[sb]: New helper.
* gnat.dg/inline7_pkg2.ad[sb]: Likewise.
* gnat.dg/inline8.adb: New test.
* gnat.dg/inline8_pkg1.ad[sb]: New helper.
* gnat.dg/inline8_pkg2.ad[sb]: New helper.
* gnat.dg/inline9.adb: New test.
* gnat.dg/inline9_pkg.ad[sb]: New helper.
* gnat.dg/inline10.adb: New test.
* gnat.dg/inline10_pkg.ad[sb]: New helper.
* gnat.dg/inline11.adb: New test.
* gnat.dg/inline11_pkg.ad[sb]: New helper.
--
Eric BotcazouIndex: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 217119)
+++ gcc-interface/utils.c (working copy)
@@ -3027,18 +3027,6 @@ create_subprog_decl (tree subprog_name,
TREE_TYPE (subprog_type));
DECL_ARGUMENTS (subprog_decl) = param_decl_list;
- /* If this is a non-inline function nested inside an inlined external
- function, we cannot honor both requests without cloning the nested
- function in the current unit since it is private to the other unit.
- We could inline the nested function as well but it's probably better
- to err on the side of too little inlining. */
- if ((inline_status == is_suppressed || inline_status == is_disabled)
- && !public_flag
- && current_function_decl
- && DECL_DECLARED_INLINE_P (current_function_decl)
- && DECL_EXTERNAL (current_function_decl))
- DECL_DECLARED_INLINE_P (current_function_decl) = 0;
-
DECL_ARTIFICIAL (subprog_decl) = artificial_flag;
DECL_EXTERNAL (subprog_decl) = extern_flag;
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 217119)
+++ gcc-interface/trans.c (working copy)
@@ -1481,6 +1481,49 @@ Pragma_to_gnu (Node_Id gnat_node)
return gnu_result;
}
+
+/* Check the inlining status of nested function FNDECL in the current context.
+
+ If a non-inline nested function is referenced from an inline external
+ function, we cannot honor both requests at the same time without cloning
+ the nested function in the current unit since it is private to its unit.
+ We could inline it as well but it's probably better to err on the side
+ of too little inlining.
+
+ This must be invoked only on nested functions present in the source code
+ and not on nested functions generated by the compiler, e.g. finalizers,
+ because they are not marked inline and we don't want them to block the
+ inlining of the parent function. */
+
+static void
+check_inlining_for_nested_subprog (tree fndecl)
+{
+ if (!DECL_DECLARED_INLINE_P (fndecl)
+ && current_function_decl
+ && DECL_EXTERNAL (current_function_decl)
+ && DECL_DECLARED_INLINE_P (current_function_decl))
+ {
+ const location_t loc1 = DECL_SOURCE_LOCATION (fndecl);
+ const location_t loc2 = DECL_SOURCE_LOCATION (current_function_decl);
+
+ if (lookup_attribute ("always_inline",
+ DECL_ATTRIBUTES (current_function_decl)))
+ {
+ error_at (loc1, "subprogram %q+F not marked Inline_Always", fndecl);
+ error_at (loc2, "parent subprogram cannot be inlined");
+ }
+ else
+ {
+ warning_at (loc1, OPT_Winline, "subprogram %q+F not marked Inline",
+ fndecl);
+ warning_at (loc2, OPT_Winline, "parent subprogram cannot be inlined");
+ }
+
+ DECL_DECLARED_INLINE_P (current_function_decl) = 0;
+ DECL_UNINLINABLE (current_function_decl) = 1;
+ }
+}
+
/* Return an expression for the length of TYPE, an integral type, computed in
RESULT_TYPE, another integral type.
@@ -1696,6 +1739,9 @@ Attribute_to_gnu (Node_Id gnat_node, tre
{
set_expr_location_from_node (gnu_expr, gnat_node);
+ /* Also check the inlining status. */
+ check_inlining_for_nested_subprog (TREE_OPERAND (gnu_expr, 0));
+
/* Check that we're not violating the No_Implicit_Dynamic_Code
restriction. Be conservative if we don't know anything
about the trampoline strategy for the target. */
@@ -3729,7 +3775,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_nod
gnu_subprog_language->other_ret_val = NULL;
}
- rest_of_subprog_body_compilation (gnu_subprog_decl);
+ /* If this is an inlined external function that has been marked uninlinable,
+ drop the body and stop there. Otherwise compile the body. */
+ if (DECL_EXTERNAL (gnu_subprog_decl) && DECL_UNINLINABLE (gnu_subprog_decl))
+ DECL_SAVED_TREE (gnu_subprog_decl) = NULL_TREE;
+ else
+ rest_of_subprog_body_compilation (gnu_subprog_decl);
}
/* Return true if GNAT_NODE requires atomic synchronization. */
@@ -3874,6 +3925,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
return call_expr;
}
+ /* For a call to a nested function, check the inlining status. */
+ if (TREE_CODE (gnu_subprog) == FUNCTION_DECL
+ && decl_function_context (gnu_subprog))
+ check_inlining_for_nested_subprog (gnu_subprog);
+
/* The only way we can be making a call via an access type is if Name is an
explicit dereference. In that case, get the list of formal args from the
type the access type is pointing to. Otherwise, get the formals from the-- { dg-do compile }
with Inline1_Pkg; use Inline1_Pkg;
procedure Inline1 is
F : Float := Invalid_Real;
begin
if Valid_Real (F) then
F := F + 1.0;
end if;
end;with Ada.Unchecked_Conversion;
package body Inline1_Pkg is
type Ieee_Short_Real is
record
Mantisse_Sign : Integer range 0 .. 1;
Exponent : Integer range 0 .. 2 ** 8 - 1;
Mantisse : Integer range 0 .. 2 ** 23 - 1;
end record;
for Ieee_Short_Real use
record
Mantisse_Sign at 0 range 31 .. 31;
Exponent at 0 range 23 .. 30;
Mantisse at 0 range 0 .. 22;
end record;
function Valid_Real (Number : Float) return Boolean is
function To_Ieee_Short_Real is
new Ada.Unchecked_Conversion (Float, Ieee_Short_Real);
begin
return To_Ieee_Short_Real (Number).Exponent /= 255;
end Valid_Real;
function Invalid_Real return Float is
function To_Float is
new Ada.Unchecked_Conversion (Ieee_Short_Real, Float);
begin
return To_Float (Ieee_Short_Real'(Mantisse_Sign => 0,
Exponent => 255, Mantisse => 0));
end Invalid_Real;
end Inline1_Pkg;package Inline1_Pkg is
function Valid_Real (Number : Float) return Boolean;
pragma Inline_Always (Valid_Real);
function Invalid_Real return Float;
pragma Inline_Always (Invalid_Real);
end Inline1_Pkg;
package Inline2_Pkg is
function Valid_Real (Number : Float) return Boolean;
pragma Inline (Valid_Real);
function Invalid_Real return Float;
pragma Inline (Invalid_Real);
end Inline2_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
with Inline2_Pkg; use Inline2_Pkg;
procedure Inline2 is
F : Float := Invalid_Real;
begin
if Valid_Real (F) then
F := F + 1.0;
end if;
end;with Ada.Unchecked_Conversion;
package body Inline2_Pkg is
type Ieee_Short_Real is
record
Mantisse_Sign : Integer range 0 .. 1;
Exponent : Integer range 0 .. 2 ** 8 - 1;
Mantisse : Integer range 0 .. 2 ** 23 - 1;
end record;
for Ieee_Short_Real use
record
Mantisse_Sign at 0 range 31 .. 31;
Exponent at 0 range 23 .. 30;
Mantisse at 0 range 0 .. 22;
end record;
function Valid_Real (Number : Float) return Boolean is
function To_Ieee_Short_Real is
new Ada.Unchecked_Conversion (Float, Ieee_Short_Real);
begin
return To_Ieee_Short_Real (Number).Exponent /= 255;
end Valid_Real;
function Invalid_Real return Float is
function To_Float is
new Ada.Unchecked_Conversion (Ieee_Short_Real, Float);
begin
return To_Float (Ieee_Short_Real'(Mantisse_Sign => 0,
Exponent => 255, Mantisse => 0));
end Invalid_Real;
end Inline2_Pkg;-- { dg-do compile }
-- { dg-error "not marked Inline_Always" "" { target *-*-* } 0 }
-- { dg-error "cannot be inlined" "" { target *-*-* } 0 }
with Inline3_Pkg; use Inline3_Pkg;
procedure Inline3 is
begin
Test (0);
end;package body Inline3_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline3_Pkg;package Inline3_Pkg is
procedure Test (I : Integer);
pragma Inline_Always (Test);
end Inline3_Pkg;
-- { dg-do compile }
with Inline4_Pkg; use Inline4_Pkg;
procedure Inline4 is
begin
Test (0);
end;package body Inline4_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
pragma Inline_Always (F);
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline4_Pkg;package Inline4_Pkg is
procedure Test (I : Integer);
pragma Inline_Always (Test);
end Inline4_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
-- { dg-warning "not marked Inline" "" { target *-*-* } 0 }
-- { dg-warning "cannot be inlined" "" { target *-*-* } 0 }
with Inline5_Pkg; use Inline5_Pkg;
procedure Inline5 is
begin
Test (0);
end;package body Inline5_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline5_Pkg;package Inline5_Pkg is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline5_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
with Inline6_Pkg; use Inline6_Pkg;
procedure Inline6 is
begin
Test (0);
end;package body Inline6_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
pragma Inline (F);
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline6_Pkg;package Inline6_Pkg is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline6_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
-- { dg-warning "not marked Inline" "" { target *-*-* } 0 }
-- { dg-warning "cannot be inlined" "" { target *-*-* } 0 }
with Inline7_Pkg1; use Inline7_Pkg1;
procedure Inline7 is
begin
Test (0);
end;with Inline7_Pkg2;
package body Inline7_Pkg1 is
procedure Test (I : Integer) is
function F is new Inline7_Pkg2.Calc (I);
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline7_Pkg1;package Inline7_Pkg1 is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline7_Pkg1;
package body Inline7_Pkg2 is
function Calc (A : Integer) return Integer is
begin
return D - A;
end;
end Inline7_Pkg2;package Inline7_Pkg2 is
generic
D : Integer;
function Calc (A : Integer) return Integer;
end Inline7_Pkg2;-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
with Inline8_Pkg1; use Inline8_Pkg1;
procedure Inline8 is
begin
Test (0);
end;with Inline8_Pkg2;
package body Inline8_Pkg1 is
procedure Test (I : Integer) is
function F is new Inline8_Pkg2.Calc (I);
pragma Inline (F);
begin
if I /= F (I) then
raise Program_Error;
end if;
end;
end Inline8_Pkg1;package Inline8_Pkg1 is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline8_Pkg1;
package body Inline8_Pkg2 is
function Calc (A : Integer) return Integer is
begin
return D - A;
end;
end Inline8_Pkg2;package Inline8_Pkg2 is
generic
D : Integer;
function Calc (A : Integer) return Integer;
end Inline8_Pkg2;-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
-- { dg-warning "not marked Inline" "" { target *-*-* } 0 }
-- { dg-warning "cannot be inlined" "" { target *-*-* } 0 }
with Inline9_Pkg; use Inline9_Pkg;
procedure Inline9 is
begin
Test (0);
end;package body Inline9_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
type FPT is access function (I : Integer) return Integer;
P : FPT := F'Access;
begin
if I /= P (I) then
raise Program_Error;
end if;
end;
end Inline9_Pkg;-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
with Inline10_Pkg; use Inline10_Pkg;
procedure Inline10 is
begin
Test (0);
end;package Inline9_Pkg is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline9_Pkg;
package body Inline10_Pkg is
procedure Test (I : Integer) is
function F (J : Integer) return Integer is
begin
return I - J;
end;
pragma Inline (F);
type FPT is access function (I : Integer) return Integer;
P : FPT := F'Access;
begin
if I /= P (I) then
raise Program_Error;
end if;
end;
end Inline10_Pkg;-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
with Inline11_Pkg; use Inline11_Pkg;
procedure Inline11 is
begin
Trace (0);
end;package Inline10_Pkg is
procedure Test (I : Integer);
pragma Inline (Test);
end Inline10_Pkg;
with Ada.Text_IO; use Ada.Text_IO;
package body Inline11_Pkg is
function My_Img (I : Integer) return String is
begin
return I'Img;
end;
procedure Trace (I : Integer) is
begin
Put_Line (My_Img (I));
end;
end Inline11_Pkg;package Inline11_Pkg is
procedure Trace (I : Integer);
pragma Inline (Trace);
end Inline11_Pkg;
