gcc/testsuite/gnat.dg/enum4.adb

   1 --  { dg-do run }
   2
   3 procedure Enum4 is
   4
   5    procedure Assert (Expected, Actual : String) is
   6    begin
   7       if Expected /= Actual then
   8          raise Program_Error;
   9       end if;
  10    end Assert;
  11
  12    procedure Test_1 is
  13       type Test_Enum is (Enum_1,     Enum_2);
  14       for Test_Enum use (Enum_1=> 8, Enum_2=> 12);
  15
  16       Enum_Values : constant array (Test_Enum) of Natural := (8, 12);
  17
  18       type Test_Enum_Rep is range 1..12;
  19       Tmp_Test_Enum_Rep : Test_Enum_Rep;
  20    begin
  21       Tmp_Test_Enum_Rep := Test_Enum'Enum_Rep (Test_Enum'First);
  22       Assert (" 8", Tmp_Test_Enum_Rep'Img);
  23
  24       for Enum in Test_Enum loop
  25          Tmp_Test_Enum_Rep := Test_Enum'Enum_Rep (Enum);
  26          Assert (Enum_Values (Enum)'Img, Tmp_Test_Enum_Rep'Img);
  27       end loop;
  28    end Test_1;
  29
  30    procedure Test_2 is
  31       type Test_Enum is (Enum_1);
  32       for Test_Enum use (Enum_1=> 2);
  33
  34       type Test_Enum_Rep_Full is range 0..2;
  35       subtype Test_Enum_Rep_Short is
  36         Test_Enum_Rep_Full range 2..Test_Enum_Rep_Full'Last;
  37
  38       Tmp_Test_Enum_Rep_Full  : Test_Enum_Rep_Full;
  39       Tmp_Test_Enum_Rep_Short : Test_Enum_Rep_Short;
  40
  41    begin
  42       Tmp_Test_Enum_Rep_Short := Test_Enum'Enum_Rep (Test_Enum'First);
  43       Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
  44
  45       for Enum in Test_Enum loop
  46          Tmp_Test_Enum_Rep_Full := Test_Enum'Enum_Rep (Enum);
  47          Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
  48       end loop;
  49
  50       for Enum in Test_Enum range Test_Enum'First .. Test_Enum'Last loop
  51          Tmp_Test_Enum_Rep_Short := Test_Enum'Enum_Rep(Enum);  --  Test #2
  52          Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
  53       end loop;
  54    end Test_2;
  55
  56 begin
  57    Test_1;
  58    Test_2;
  59 end;