public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Changes related to back-end inlining
@ 2014-10-31 11:18 Arnaud Charlet
  2014-11-05 18:47 ` Eric Botcazou
  0 siblings, 1 reply; 2+ messages in thread
From: Arnaud Charlet @ 2014-10-31 11:18 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 1319 bytes --]

This change affects only back-end inlining and is two-fold:

1. It lifts in a 3rd place the limitation associated with
nested subprograms as well as with a couple of other constructs.
After it is applied, the only significant limitation left are
the nested packages.

2. It makes sure the errors associated with pragma Inline_Always
are issued whatever the optimization level, which is in keeping
with its semantics.

It makes it possible to inline/reject consistently at all
optimization levels subprograms marked with pragma Inline_Always,
for example:

package Q is
   procedure Test (I : Integer);
   pragma Inline_Always (Test);
end Q;
package body Q is
   procedure Test (I : Integer) is
      -- Uncomment to make it compile
      -- function F (J : Integer) return Integer;
      -- pragma Inline_Always (F);

      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 Q;

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

2014-10-31  Eric Botcazou  <ebotcazou@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.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 3470 bytes --]

Index: inline.adb
===================================================================
--- inline.adb	(revision 216960)
+++ inline.adb	(working copy)
@@ -1225,10 +1225,8 @@
             Error_Msg_NE (Msg & "p?", N, Subp);
          end if;
 
-         return;
+      --  New semantics relying on back end inlining
 
-      --  New semantics
-
       elsif Is_Serious then
 
          --  Remove last character (question mark) to make this into an error.
@@ -1242,10 +1240,8 @@
          Set_Is_Inlined_Always (Subp, False);
          Error_Msg_NE (Msg & "p?", N, Subp);
 
-      --  Do not issue errors/warnings when compiling with optimizations
+      else
 
-      elsif Optimization_Level = 0 then
-
          --  Do not emit warning if this is a predefined unit which is not
          --  the main unit. This behavior is currently provided for backward
          --  compatibility but it will be removed when we enforce the
@@ -1281,24 +1277,13 @@
 
             Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
 
-         else pragma Assert (Front_End_Inlining);
+         else
             Set_Is_Inlined (Subp, False);
 
-            --  When inlining cannot take place we must issue an error.
-            --  For backward compatibility we still report a warning.
-
             if Ineffective_Inline_Warnings then
                Error_Msg_NE (Msg & "p?", N, Subp);
             end if;
          end if;
-
-      --  Compiling with optimizations enabled it is too early to report
-      --  problems since the backend may still perform inlining. In order
-      --  to report unhandled inlinings the program must be compiled with
-      --  -Winline and the error is reported by the backend.
-
-      else
-         null;
       end if;
    end Cannot_Inline;
 
@@ -3327,12 +3312,26 @@
 
       D := First (Decls);
       while Present (D) loop
-         if Nkind (D) = N_Subprogram_Body then
+         --  First declarations universally excluded
+
+         if Nkind (D) = N_Package_Declaration then
             Cannot_Inline
-              ("cannot inline & (nested subprogram)?",
+              ("cannot inline & (nested package declaration)?",
                D, Subp);
             return True;
 
+         elsif Nkind (D) = N_Package_Instantiation then
+            Cannot_Inline
+              ("cannot inline & (nested package instantiation)?",
+               D, Subp);
+            return True;
+         end if;
+
+         --  Then declarations excluded only for front end inlining
+
+         if Back_End_Inlining then
+            null;
+
          elsif Nkind (D) = N_Task_Type_Declaration
            or else Nkind (D) = N_Single_Task_Declaration
          then
@@ -3349,9 +3348,9 @@
                D, Subp);
             return True;
 
-         elsif Nkind (D) = N_Package_Declaration then
+         elsif Nkind (D) = N_Subprogram_Body then
             Cannot_Inline
-              ("cannot inline & (nested package declaration)?",
+              ("cannot inline & (nested subprogram)?",
                D, Subp);
             return True;
 
@@ -3368,12 +3367,6 @@
               ("cannot inline & (nested procedure instantiation)?",
                D, Subp);
             return True;
-
-         elsif Nkind (D) = N_Package_Instantiation then
-            Cannot_Inline
-              ("cannot inline & (nested package instantiation)?",
-               D, Subp);
-            return True;
          end if;
 
          Next (D);

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [Ada] Changes related to back-end inlining
  2014-10-31 11:18 [Ada] Changes related to back-end inlining Arnaud Charlet
@ 2014-11-05 18:47 ` Eric Botcazou
  0 siblings, 0 replies; 2+ messages in thread
From: Eric Botcazou @ 2014-11-05 18:47 UTC (permalink / raw)
  To: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1913 bytes --]

> 2014-10-31  Eric Botcazou  <ebotcazou@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  <ebotcazou@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  <ebotcazou@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 Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 4685 bytes --]

Index: 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;
 }
 \f
+
+/* 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;
+    }
+}
+\f
 /* 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);
 }
 \f
 /* 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

[-- Attachment #3: inline1.adb --]
[-- Type: text/x-adasrc, Size: 176 bytes --]

-- { 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;

[-- Attachment #4: inline1_pkg.adb --]
[-- Type: text/x-adasrc, Size: 1031 bytes --]

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;

[-- Attachment #5: inline1_pkg.ads --]
[-- Type: text/x-adasrc, Size: 215 bytes --]

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;

[-- Attachment #6: inline2_pkg.ads --]
[-- Type: text/x-adasrc, Size: 201 bytes --]

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;

[-- Attachment #7: inline2.adb --]
[-- Type: text/x-adasrc, Size: 215 bytes --]

-- { 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;

[-- Attachment #8: inline2_pkg.adb --]
[-- Type: text/x-adasrc, Size: 1031 bytes --]

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;

[-- Attachment #9: inline3.adb --]
[-- Type: text/x-adasrc, Size: 224 bytes --]

-- { 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;

[-- Attachment #10: inline3_pkg.adb --]
[-- Type: text/x-adasrc, Size: 246 bytes --]

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;

[-- Attachment #11: inline3_pkg.ads --]
[-- Type: text/x-adasrc, Size: 104 bytes --]

package Inline3_Pkg is

  procedure Test (I : Integer);
  pragma Inline_Always (Test);

end Inline3_Pkg;

[-- Attachment #12: inline4.adb --]
[-- Type: text/x-adasrc, Size: 101 bytes --]

-- { dg-do compile }

with Inline4_Pkg; use Inline4_Pkg;

procedure Inline4 is
begin
  Test (0);
end;

[-- Attachment #13: inline4_pkg.adb --]
[-- Type: text/x-adasrc, Size: 275 bytes --]

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;

[-- Attachment #14: inline4_pkg.ads --]
[-- Type: text/x-adasrc, Size: 104 bytes --]

package Inline4_Pkg is

  procedure Test (I : Integer);
  pragma Inline_Always (Test);

end Inline4_Pkg;

[-- Attachment #15: inline5.adb --]
[-- Type: text/x-adasrc, Size: 260 bytes --]

-- { 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;

[-- Attachment #16: inline5_pkg.adb --]
[-- Type: text/x-adasrc, Size: 245 bytes --]

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;

[-- Attachment #17: inline5_pkg.ads --]
[-- Type: text/x-adasrc, Size: 97 bytes --]

package Inline5_Pkg is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline5_Pkg;

[-- Attachment #18: inline6.adb --]
[-- Type: text/x-adasrc, Size: 140 bytes --]

-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }

with Inline6_Pkg; use Inline6_Pkg;

procedure Inline6 is
begin
  Test (0);
end;

[-- Attachment #19: inline6_pkg.adb --]
[-- Type: text/x-adasrc, Size: 268 bytes --]

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;

[-- Attachment #20: inline6_pkg.ads --]
[-- Type: text/x-adasrc, Size: 97 bytes --]

package Inline6_Pkg is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline6_Pkg;

[-- Attachment #21: inline7.adb --]
[-- Type: text/x-adasrc, Size: 262 bytes --]

-- { 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;

[-- Attachment #22: inline7_pkg1.adb --]
[-- Type: text/x-adasrc, Size: 226 bytes --]

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;

[-- Attachment #23: inline7_pkg1.ads --]
[-- Type: text/x-adasrc, Size: 99 bytes --]

package Inline7_Pkg1 is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline7_Pkg1;

[-- Attachment #24: inline7_pkg2.adb --]
[-- Type: text/x-adasrc, Size: 129 bytes --]

package body Inline7_Pkg2 is

  function Calc (A : Integer) return Integer is
  begin
    return D - A;
  end;

end Inline7_Pkg2;

[-- Attachment #25: inline7_pkg2.ads --]
[-- Type: text/x-adasrc, Size: 116 bytes --]

package Inline7_Pkg2 is

  generic
    D : Integer;
  function Calc (A : Integer) return Integer;

end Inline7_Pkg2;

[-- Attachment #26: inline8.adb --]
[-- Type: text/x-adasrc, Size: 142 bytes --]

-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }

with Inline8_Pkg1; use Inline8_Pkg1;

procedure Inline8 is
begin
  Test (0);
end;

[-- Attachment #27: inline8_pkg1.adb --]
[-- Type: text/x-adasrc, Size: 249 bytes --]

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;

[-- Attachment #28: inline8_pkg1.ads --]
[-- Type: text/x-adasrc, Size: 99 bytes --]

package Inline8_Pkg1 is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline8_Pkg1;

[-- Attachment #29: inline8_pkg2.adb --]
[-- Type: text/x-adasrc, Size: 129 bytes --]

package body Inline8_Pkg2 is

  function Calc (A : Integer) return Integer is
  begin
    return D - A;
  end;

end Inline8_Pkg2;

[-- Attachment #30: inline8_pkg2.ads --]
[-- Type: text/x-adasrc, Size: 116 bytes --]

package Inline8_Pkg2 is

  generic
    D : Integer;
  function Calc (A : Integer) return Integer;

end Inline8_Pkg2;

[-- Attachment #31: inline9.adb --]
[-- Type: text/x-adasrc, Size: 260 bytes --]

-- { 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;

[-- Attachment #32: inline9_pkg.adb --]
[-- Type: text/x-adasrc, Size: 334 bytes --]

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;

[-- Attachment #33: inline10.adb --]
[-- Type: text/x-adasrc, Size: 143 bytes --]

-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }

with Inline10_Pkg; use Inline10_Pkg;

procedure Inline10 is
begin
  Test (0);
end;

[-- Attachment #34: inline9_pkg.ads --]
[-- Type: text/x-adasrc, Size: 97 bytes --]

package Inline9_Pkg is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline9_Pkg;

[-- Attachment #35: inline10_pkg.adb --]
[-- Type: text/x-adasrc, Size: 359 bytes --]

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;

[-- Attachment #36: inline11.adb --]
[-- Type: text/x-adasrc, Size: 144 bytes --]

-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }

with Inline11_Pkg; use Inline11_Pkg;

procedure Inline11 is
begin
  Trace (0);
end;

[-- Attachment #37: inline10_pkg.ads --]
[-- Type: text/x-adasrc, Size: 99 bytes --]

package Inline10_Pkg is

  procedure Test (I : Integer);
  pragma Inline (Test);

end Inline10_Pkg;

[-- Attachment #38: inline11_pkg.adb --]
[-- Type: text/x-adasrc, Size: 244 bytes --]

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;

[-- Attachment #39: inline11_pkg.ads --]
[-- Type: text/x-adasrc, Size: 101 bytes --]

package Inline11_Pkg is

  procedure Trace (I : Integer);
  pragma Inline (Trace);

end Inline11_Pkg;

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2014-11-05 18:47 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-10-31 11:18 [Ada] Changes related to back-end inlining Arnaud Charlet
2014-11-05 18:47 ` Eric Botcazou

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).