gcc/testsuite/gnat.dg/outer_agg_bitfield_constructor.adb

   1 -- { dg-do run }
   2
   3 procedure Outer_Agg_Bitfield_Constructor is
   4
   5     type Mod_64 is mod 2 ** 64;
   6     for Mod_64'Size use 64;
   7
   8     type Uint_16 is range 0 .. 2 ** 16 - 1;
   9     for Uint_16'Size use 16;
  10
  11     type Values_Type is record
  12        M64 : Mod_64;
  13        U16 : Uint_16;
  14     end record;
  15
  16     for Values_Type use record
  17        M64 at 0 range 0 .. 63;
  18        U16 at 8 range 0 .. 15;
  19     end record;
  20
  21     type Wrapper_Type is record
  22        Values : Values_Type;
  23     end record;
  24
  25     for Wrapper_Type use record
  26        Values at 0 range 0 .. 79;
  27     end record;
  28
  29     M : constant := 2;
  30     U : constant := 4;
  31
  32     W : Wrapper_Type := (Values => (M, U));
  33
  34     procedure Check (O : Wrapper_Type) is
  35     begin
  36        if O.Values.M64 /= M or else O.Values.U16 /= U then
  37           raise Program_Error;
  38        end if;
  39     end;
  40 begin
  41    Check (W);
  42 end;
  43
  44