gcc/testsuite/gnat.dg/boolean_bitfield.adb

   1 -- { dg-do run }
   2 -- { dg-options "-O" }
   3
   4 with System; use System;
   5
   6 procedure Boolean_Bitfield is
   7
   8   Units_Per_Integer : constant :=
   9     (Integer'Size + System.Storage_Unit - 1) / System.Storage_Unit;
  10
  11   type E_type is (Red, Blue, Green);
  12
  13   type Parent_Type is record
  14     I : Integer range 0 .. 127 := 127;
  15     C : Character := 'S';
  16     B : Boolean := False;
  17     E : E_Type := Blue;
  18   end record;
  19
  20   for Parent_Type use record
  21     C at 0 * Units_Per_Integer range 0 .. Character'Size - 1;
  22     B at 1 * Units_Per_Integer range 0 .. Boolean'Size - 1;
  23     I at 2 * Units_Per_Integer range 0 .. Integer'Size/2 - 1;
  24     E at 3 * Units_Per_Integer range 0 .. Character'Size - 1;
  25   end record;
  26
  27   type Derived_Type is new Parent_Type;
  28
  29   for Derived_Type use record
  30     C at 1 * Units_Per_Integer range 1 .. Character'Size + 1;
  31     B at 3 * Units_Per_Integer range 1 .. Boolean'Size + 1;
  32     I at 5 * Units_Per_Integer range 1 .. Integer'Size/2 + 1;
  33     E at 7 * Units_Per_Integer range 1 .. Character'Size + 1;
  34   end record;
  35
  36   Rec   : Derived_Type;
  37
  38 begin
  39   Rec := (12, 'T', True, Red);
  40
  41   if (Rec.I /= 12) or (Rec.C /= 'T') or (not Rec.B) or (Rec.E /= Red) then
  42     raise Program_Error;
  43   end if;
  44 end;