gcc/testsuite/gnat.dg/trampoline2.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatws" }
   3
   4 with System; use System;
   5
   6 procedure Trampoline2 is
   7
   8   A : Integer;
   9
  10   type FuncPtr is access function (I : Integer) return Integer;
  11
  12   function F (I : Integer) return Integer is
  13   begin
  14     return A + I;
  15   end F;
  16
  17   P : FuncPtr := F'Access;
  18   CA : System.Address := F'Code_Address;
  19   I : Integer;
  20
  21 begin
  22   if CA = System.Null_Address then
  23     raise Program_Error;
  24   end if;
  25
  26   I := P(0);
  27 end;