gcc/testsuite/gnat.dg/nested_proc1.adb

   1 -- { dg-do run }
   2 -- Test that a static link is correctly passed to a subprogram which is
   3 -- indirectly called through an aggregate.
   4
   5 procedure Nested_Proc1 is
   6
   7   I : Integer := 0;
   8
   9   procedure P1 (X : Integer) is
  10   begin
  11     I := X;
  12   end;
  13
  14   type Func_Ptr is access procedure (X : Integer);
  15
  16   type Arr is array (1..64) of Integer;
  17
  18   type Rec is record
  19     F : Func_Ptr;
  20     A : Arr;
  21   end record;
  22
  23   procedure P2 (R : Rec) is
  24   begin
  25      R.F (1);
  26   end;
  27
  28 begin
  29   P2 ((F => P1'Access, A => (others => 0)));
  30   if I /= 1 then
  31     raise Program_Error;
  32   end if;
  33 end;