gcc/testsuite/gnat.dg/tag1.adb

   1 --  { dg-do run }
   2
   3 with Ada.Tags;
   4 procedure tag1 is
   5    type T is tagged null record;
   6    X : Ada.Tags.Tag;
   7 begin
   8    begin
   9      X := Ada.Tags.Descendant_Tag ("Internal tag at 16#0#", T'Tag);
  10      raise Program_Error;
  11    exception
  12      when Ada.Tags.Tag_Error => null;
  13    end;
  14    begin
  15      X := Ada.Tags.Descendant_Tag ("Internal tag at 16#XXXX#", T'Tag);
  16      raise Program_Error;
  17    exception
  18      when Ada.Tags.Tag_Error => null;
  19    end;
  20 end;