gcc/testsuite/gnat.dg/timing_events.adb

   1 -- { dg-do run }
   2
   3 procedure Timing_Events is
   4    type Timing_Event_Handler is access protected procedure;
   5
   6    protected PO is
   7       entry     Test;
   8       procedure Proc;
   9    private
  10       Data : Integer := 99;
  11    end PO;
  12
  13    protected body PO is
  14       entry Test when True is
  15          Handler : Timing_Event_Handler := Proc'Access;
  16       begin
  17          Handler.all;
  18       end Test;
  19
  20       procedure Proc is
  21       begin
  22          if Data /= 99 then
  23             raise Program_Error;
  24          end if;
  25       end Proc;
  26    end PO;
  27 begin
  28    PO.Test;
  29 end;