gcc/testsuite/gnat.dg/test_self_ref.adb

   1 -- { dg-do run }
   2
   3 procedure Test_Self_Ref is
   4    type T2;
   5    type T2_Ref is access all T2;
   6
   7    function F (X: T2_Ref) return Integer;
   8
   9    type T2 is limited record
  10       Int1 : Integer := F (T2'Unchecked_Access);
  11       Int2 : Integer := F (T2'Unrestricted_Access);
  12    end record;
  13
  14    Counter : Integer := 2;
  15
  16    function F (X: T2_Ref) return Integer is
  17    begin
  18       Counter := Counter * 5;
  19       return Counter;
  20    end F;
  21
  22    Obj1 : T2_Ref := new T2'(10,20);
  23    Obj2 : T2_Ref := new T2;
  24    Obj3 : T2_Ref := new T2'(others => <>);
  25
  26 begin
  27   if Obj1.Int1 /= 10 or else Obj1.Int2 /= 20 then
  28      raise Program_Error;
  29   end if;
  30   if Obj2.Int1 /= 10 or else Obj2.Int2 /= 50 then
  31      raise Program_Error;
  32   end if;
  33   if Obj3.Int1 /= 250 or else Obj3.Int2 /= 1250 then
  34      raise Program_Error;
  35   end if;
  36 end Test_Self_Ref;