gcc/testsuite/gnat.dg/component_size.adb

   1 --  { dg-do run }
   2
   3 procedure Component_Size is
   4
   5    C_Unsigned_Long_Size : constant := 32;
   6    type T_Unsigned_Long is range 0 .. (2 ** 31) - 1;
   7    for T_Unsigned_Long'Size use C_Unsigned_Long_Size;
   8
   9    C_Unsigned_Byte_Size : constant := 8;
  10    type T_Unsigned_Byte is range 0 .. (2 ** 8) - 1;
  11    for T_Unsigned_Byte'Size use C_Unsigned_Byte_Size;
  12
  13    type T_Unsigned_Byte_Without_Size_Repr is range 0 .. (2 ** 8) - 1;
  14
  15    C_Nb_Data : constant T_Unsigned_Long := 9;
  16    subtype T_Nb_Data is T_Unsigned_Long range 1 .. C_Nb_Data;
  17
  18    type T_Wrong_Id is array (T_Nb_Data) of T_Unsigned_Byte;
  19    for T_Wrong_Id'Component_Size use C_Unsigned_Long_Size;
  20
  21    type T_Correct_Id is array (T_Nb_Data) of T_Unsigned_Byte_Without_Size_Repr;
  22    for T_Correct_Id'Component_Size use C_Unsigned_Long_Size;
  23
  24    C_Value : constant := 1;
  25
  26    C_Wrong_Id : constant T_Wrong_Id := T_Wrong_Id'(others => C_Value);
  27    C_Correct_Id : constant T_Correct_Id := T_Correct_Id'(others => C_Value);
  28
  29 begin
  30    if C_Correct_Id /= T_Correct_Id'(others => C_Value) then
  31       raise Program_Error;
  32    end if;
  33
  34    if C_Wrong_Id /= T_Wrong_Id'(others => C_Value) then
  35       raise Program_Error;
  36    end if;
  37 end;