gcc/testsuite/gnat.dg/access_test.adb

   1 -- { dg-do run }
   2
   3 procedure Access_Test is
   4
   5    type T1 is tagged null record;
   6
   7    procedure Proc_1 (P : access T1'Class)  is
   8       type Ref is access T1'Class;
   9       X : Ref := new T1'Class'(P.all);  -- Should always work (no exception)
  10
  11    begin
  12       null;
  13    end;
  14
  15    procedure Proc_2 is
  16       type T2 is new T1 with null record;
  17       X2 : aliased T2;
  18
  19    begin
  20       Proc_1 (X2'access);
  21
  22       declare
  23          type T3 is new T1 with null record;
  24          X3 :  aliased T3;
  25
  26       begin
  27          Proc_1 (X3'access);
  28       end;
  29    end;
  30
  31 begin
  32    Proc_2;
  33 end;