gcc/testsuite/gnat.dg/interface1.adb

   1 -- { dg-do run }
   2
   3 with System;
   4 procedure Interface1 is
   5    package Pkg is
   6       type I1 is interface;
   7       type Root is tagged record
   8          Data : string (1 .. 300);
   9       end record;
  10       type DT is new Root and I1 with null record;
  11    end Pkg;
  12    use Pkg;
  13    use type System.Address;
  14    Obj : DT;
  15    procedure IW (O : I1'Class) is
  16    begin
  17       if O'Address /= Obj'Address then
  18          raise Program_Error;
  19       end if;
  20    end IW;
  21 begin
  22    IW (Obj);
  23 end Interface1;