gcc/testsuite/gnat.dg/loop_optimization2.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-gnata -O2 -fno-inline" }
   3
   4 with Ada.Unchecked_Conversion;
   5
   6 package body Loop_Optimization2 is
   7
   8    function To_Addr_Ptr is
   9       new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
  10
  11    function To_Address is
  12      new Ada.Unchecked_Conversion (Tag, System.Address);
  13
  14    function To_Type_Specific_Data_Ptr is
  15      new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
  16
  17    function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
  18       TSD_Ptr : constant Addr_Ptr := To_Addr_Ptr (To_Address (T));
  19       TSD : constant Type_Specific_Data_Ptr :=
  20                       To_Type_Specific_Data_Ptr (TSD_Ptr.all);
  21       Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
  22    begin
  23       if Iface_Table = null then
  24          declare
  25             Table : Tag_Array (1 .. 0);
  26          begin
  27             return Table;
  28          end;
  29       else
  30          declare
  31             Table : Tag_Array (1 .. Iface_Table.Nb_Ifaces);
  32          begin
  33             for J in 1 .. Iface_Table.Nb_Ifaces loop
  34                Table (J) := Iface_Table.Ifaces_Table (J).Iface_Tag;
  35             end loop;
  36             return Table;
  37          end;
  38       end if;
  39    end Interface_Ancestor_Tags;
  40
  41 end Loop_Optimization2;