gcc/testsuite/gnat.dg/tamdt.adb

   1
   2 with Tamdt_Aux;
   3
   4 package body TAMDT is
   5    type TAMT1 is new Tamdt_Aux.Priv (X => 1);
   6    type TAMT2 is new Tamdt_Aux.Priv;
   7
   8    procedure Check is
   9       Ptr1 : TAMT1_Access := new TAMT1;
  10       Ptr2 : TAMT2_Access := new TAMT2 (X => 2);
  11    begin
  12       if Ptr1.all.X /= 1 then
  13          raise Program_Error;
  14       end if;
  15       if Ptr2.all.X /= 2 then
  16          raise Program_Error;
  17       end if;
  18    end;
  19 end;