gcc/testsuite/gnat.dg/loop_optimization24.adb

   1 -- { dg-do run }
   2 -- { dg-options "-O" }
   3
   4 procedure Loop_Optimization24 is
   5
   6    procedure Callback is
   7    begin
   8       raise Constraint_Error;
   9    end;
  10
  11    type Thread_Name_Ptr is access constant String;
  12    type Callback_Ptr is access procedure;
  13
  14    type Callback_Information is record
  15       Name : Thread_Name_Ptr;
  16       Proc : Callback_Ptr;
  17    end record;
  18
  19    type Callback_List is array (Positive range <>) of Callback_Information;
  20
  21    Cbs : Callback_List
  22      := (1 => (Proc => Callback'access, name => new String'("Callback")),
  23          2 => (Proc => Callback'access, name => new String'("Callback")));
  24
  25 begin
  26    for Index in Cbs'Range loop
  27       begin
  28          if Cbs(Index).proc /= null then
  29             Cbs(Index).proc.all;
  30          end if;
  31       exception
  32          when Constraint_Error => null;
  33       end;
  34    end loop;
  35 end;