From: Eric Botcazou Date: Wed, 5 Nov 2014 18:47:04 +0000 (+0000) Subject: utils.c (create_subprog_decl): Move code dealing with conflicting inlining status... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=87411e95ef8727a9aea86bb86a0773da3a769815;p=gcc.git utils.c (create_subprog_decl): Move code dealing with conflicting inlining status of nested subprograms to... * 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) : 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. From-SVN: r217151 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1a12ce3f451..916715ad62e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2014-11-05 Eric Botcazou + + * 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) : 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-10-31 Hristian Kirtchev * aspects.adb Add an entry for aspect Ghost in table diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index a343261dce9..258b79cbb52 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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, tree *gnu_result_type_p, int attribute) { 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_node) 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 *gnu_result_type_p, tree gnu_target, 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 diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 39350f75dee..4d350605552 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3027,18 +3027,6 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a8aa838e1b9..d227828c321 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,30 @@ +2014-11-05 Eric Botcazou + + * 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. + 2014-11-05 Anthony Brandon PR driver/36312 diff --git a/gcc/testsuite/gnat.dg/inline1.adb b/gcc/testsuite/gnat.dg/inline1.adb new file mode 100644 index 00000000000..d62b8596dea --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline1.adb @@ -0,0 +1,11 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline10.adb b/gcc/testsuite/gnat.dg/inline10.adb new file mode 100644 index 00000000000..08453300907 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline10.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -Winline" } + +with Inline10_Pkg; use Inline10_Pkg; + +procedure Inline10 is +begin + Test (0); +end; diff --git a/gcc/testsuite/gnat.dg/inline10_pkg.adb b/gcc/testsuite/gnat.dg/inline10_pkg.adb new file mode 100644 index 00000000000..cf5d8611207 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline10_pkg.adb @@ -0,0 +1,21 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline10_pkg.ads b/gcc/testsuite/gnat.dg/inline10_pkg.ads new file mode 100644 index 00000000000..ba648244b0d --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline10_pkg.ads @@ -0,0 +1,6 @@ +package Inline10_Pkg is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline10_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline11.adb b/gcc/testsuite/gnat.dg/inline11.adb new file mode 100644 index 00000000000..cf8e1335f12 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline11.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -Winline" } + +with Inline11_Pkg; use Inline11_Pkg; + +procedure Inline11 is +begin + Trace (0); +end; diff --git a/gcc/testsuite/gnat.dg/inline11_pkg.adb b/gcc/testsuite/gnat.dg/inline11_pkg.adb new file mode 100644 index 00000000000..8303ebac0a6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline11_pkg.adb @@ -0,0 +1,15 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline11_pkg.ads b/gcc/testsuite/gnat.dg/inline11_pkg.ads new file mode 100644 index 00000000000..a06bbaccda8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline11_pkg.ads @@ -0,0 +1,6 @@ +package Inline11_Pkg is + + procedure Trace (I : Integer); + pragma Inline (Trace); + +end Inline11_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline1_pkg.adb b/gcc/testsuite/gnat.dg/inline1_pkg.adb new file mode 100644 index 00000000000..957971d5f86 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline1_pkg.adb @@ -0,0 +1,34 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline1_pkg.ads b/gcc/testsuite/gnat.dg/inline1_pkg.ads new file mode 100644 index 00000000000..32e710ba5d9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline1_pkg.ads @@ -0,0 +1,9 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline2.adb b/gcc/testsuite/gnat.dg/inline2.adb new file mode 100644 index 00000000000..1c15d98065e --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline2.adb @@ -0,0 +1,12 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline2_pkg.adb b/gcc/testsuite/gnat.dg/inline2_pkg.adb new file mode 100644 index 00000000000..539b4a5e87d --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline2_pkg.adb @@ -0,0 +1,34 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline2_pkg.ads b/gcc/testsuite/gnat.dg/inline2_pkg.ads new file mode 100644 index 00000000000..e9949928a21 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline2_pkg.ads @@ -0,0 +1,9 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline3.adb b/gcc/testsuite/gnat.dg/inline3.adb new file mode 100644 index 00000000000..b0ba51360da --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline3.adb @@ -0,0 +1,10 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline3_pkg.adb b/gcc/testsuite/gnat.dg/inline3_pkg.adb new file mode 100644 index 00000000000..229075b92bf --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline3_pkg.adb @@ -0,0 +1,17 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline3_pkg.ads b/gcc/testsuite/gnat.dg/inline3_pkg.ads new file mode 100644 index 00000000000..c5de874ca95 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline3_pkg.ads @@ -0,0 +1,6 @@ +package Inline3_Pkg is + + procedure Test (I : Integer); + pragma Inline_Always (Test); + +end Inline3_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline4.adb b/gcc/testsuite/gnat.dg/inline4.adb new file mode 100644 index 00000000000..ee914f9802a --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline4.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } + +with Inline4_Pkg; use Inline4_Pkg; + +procedure Inline4 is +begin + Test (0); +end; diff --git a/gcc/testsuite/gnat.dg/inline4_pkg.adb b/gcc/testsuite/gnat.dg/inline4_pkg.adb new file mode 100644 index 00000000000..cd01eda4f33 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline4_pkg.adb @@ -0,0 +1,17 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline4_pkg.ads b/gcc/testsuite/gnat.dg/inline4_pkg.ads new file mode 100644 index 00000000000..9a56ce5668b --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline4_pkg.ads @@ -0,0 +1,6 @@ +package Inline4_Pkg is + + procedure Test (I : Integer); + pragma Inline_Always (Test); + +end Inline4_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline5.adb b/gcc/testsuite/gnat.dg/inline5.adb new file mode 100644 index 00000000000..45803fabf77 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline5.adb @@ -0,0 +1,11 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline5_pkg.adb b/gcc/testsuite/gnat.dg/inline5_pkg.adb new file mode 100644 index 00000000000..66b00cab293 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline5_pkg.adb @@ -0,0 +1,16 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline5_pkg.ads b/gcc/testsuite/gnat.dg/inline5_pkg.ads new file mode 100644 index 00000000000..2d2e9c332ab --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline5_pkg.ads @@ -0,0 +1,6 @@ +package Inline5_Pkg is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline5_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline6.adb b/gcc/testsuite/gnat.dg/inline6.adb new file mode 100644 index 00000000000..1d9e5b9fe41 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline6.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -Winline" } + +with Inline6_Pkg; use Inline6_Pkg; + +procedure Inline6 is +begin + Test (0); +end; diff --git a/gcc/testsuite/gnat.dg/inline6_pkg.adb b/gcc/testsuite/gnat.dg/inline6_pkg.adb new file mode 100644 index 00000000000..8f2d5777f83 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline6_pkg.adb @@ -0,0 +1,17 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline6_pkg.ads b/gcc/testsuite/gnat.dg/inline6_pkg.ads new file mode 100644 index 00000000000..dd0b498ed27 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline6_pkg.ads @@ -0,0 +1,6 @@ +package Inline6_Pkg is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline6_Pkg; diff --git a/gcc/testsuite/gnat.dg/inline7.adb b/gcc/testsuite/gnat.dg/inline7.adb new file mode 100644 index 00000000000..2c2a46a22fd --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline7.adb @@ -0,0 +1,11 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline7_pkg1.adb b/gcc/testsuite/gnat.dg/inline7_pkg1.adb new file mode 100644 index 00000000000..c9055211786 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline7_pkg1.adb @@ -0,0 +1,15 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline7_pkg1.ads b/gcc/testsuite/gnat.dg/inline7_pkg1.ads new file mode 100644 index 00000000000..6a69ec7b862 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline7_pkg1.ads @@ -0,0 +1,6 @@ +package Inline7_Pkg1 is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline7_Pkg1; diff --git a/gcc/testsuite/gnat.dg/inline7_pkg2.adb b/gcc/testsuite/gnat.dg/inline7_pkg2.adb new file mode 100644 index 00000000000..b3f18705275 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline7_pkg2.adb @@ -0,0 +1,8 @@ +package body Inline7_Pkg2 is + + function Calc (A : Integer) return Integer is + begin + return D - A; + end; + +end Inline7_Pkg2; diff --git a/gcc/testsuite/gnat.dg/inline7_pkg2.ads b/gcc/testsuite/gnat.dg/inline7_pkg2.ads new file mode 100644 index 00000000000..8532c304d78 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline7_pkg2.ads @@ -0,0 +1,7 @@ +package Inline7_Pkg2 is + + generic + D : Integer; + function Calc (A : Integer) return Integer; + +end Inline7_Pkg2; diff --git a/gcc/testsuite/gnat.dg/inline8.adb b/gcc/testsuite/gnat.dg/inline8.adb new file mode 100644 index 00000000000..4e0dec84918 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline8.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatn -Winline" } + +with Inline8_Pkg1; use Inline8_Pkg1; + +procedure Inline8 is +begin + Test (0); +end; diff --git a/gcc/testsuite/gnat.dg/inline8_pkg1.adb b/gcc/testsuite/gnat.dg/inline8_pkg1.adb new file mode 100644 index 00000000000..44063213757 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline8_pkg1.adb @@ -0,0 +1,16 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline8_pkg1.ads b/gcc/testsuite/gnat.dg/inline8_pkg1.ads new file mode 100644 index 00000000000..d12cf565220 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline8_pkg1.ads @@ -0,0 +1,6 @@ +package Inline8_Pkg1 is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline8_Pkg1; diff --git a/gcc/testsuite/gnat.dg/inline8_pkg2.adb b/gcc/testsuite/gnat.dg/inline8_pkg2.adb new file mode 100644 index 00000000000..76017fc2d57 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline8_pkg2.adb @@ -0,0 +1,8 @@ +package body Inline8_Pkg2 is + + function Calc (A : Integer) return Integer is + begin + return D - A; + end; + +end Inline8_Pkg2; diff --git a/gcc/testsuite/gnat.dg/inline8_pkg2.ads b/gcc/testsuite/gnat.dg/inline8_pkg2.ads new file mode 100644 index 00000000000..2c6f1b0b222 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline8_pkg2.ads @@ -0,0 +1,7 @@ +package Inline8_Pkg2 is + + generic + D : Integer; + function Calc (A : Integer) return Integer; + +end Inline8_Pkg2; diff --git a/gcc/testsuite/gnat.dg/inline9.adb b/gcc/testsuite/gnat.dg/inline9.adb new file mode 100644 index 00000000000..d64e134acf3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline9.adb @@ -0,0 +1,11 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/inline9_pkg.adb b/gcc/testsuite/gnat.dg/inline9_pkg.adb new file mode 100644 index 00000000000..b1eb5c07bf6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline9_pkg.adb @@ -0,0 +1,20 @@ +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; diff --git a/gcc/testsuite/gnat.dg/inline9_pkg.ads b/gcc/testsuite/gnat.dg/inline9_pkg.ads new file mode 100644 index 00000000000..3f9f6752f26 --- /dev/null +++ b/gcc/testsuite/gnat.dg/inline9_pkg.ads @@ -0,0 +1,6 @@ +package Inline9_Pkg is + + procedure Test (I : Integer); + pragma Inline (Test); + +end Inline9_Pkg;