gcc/testsuite/gnat.dg/blkextract_from_reg.adb

   1 --  { dg-do run }
   2
   3 with System, Ada.Unchecked_Conversion; use System;
   4
   5 procedure BLKextract_From_Reg is
   6
   7    type Byte is range 0 .. +255;
   8    for  Byte'size use 8;
   9
  10    type RGB is array (1 .. 3) of Byte;
  11    for RGB'Size use 24;
  12
  13    type RAW_Packet is range 0 .. 2 ** 32 - 1;
  14    for  RAW_Packet'Size use 32;
  15
  16    type Composite_Packet is record
  17       Values : RGB;
  18       Pad    : Byte;
  19    end record;
  20    for Composite_Packet use record
  21       Values at 0 range 0 .. 23;
  22       Pad    at 3 range 0 .. 7;
  23    end record;
  24    for Composite_Packet'Size use 32;
  25
  26    function To_Composite_Packet is
  27       new Ada.Unchecked_Conversion (RAW_Packet, Composite_Packet);
  28
  29    function Blob return RGB is
  30       RAW_Blob : RAW_Packet := 16#01020304#;
  31    begin
  32       return To_Composite_Packet (RAW_Blob).Values;
  33    end;
  34
  35    Blob_Color : RGB := Blob;
  36    Expected_Color : RGB;
  37 begin
  38    if System.Default_Bit_Order = High_Order_First then
  39       Expected_Color := (1 => 1, 2 => 2, 3 => 3);
  40    else
  41       Expected_Color := (1 => 4, 2 => 3, 3 => 2);
  42    end if;
  43
  44    for I in Blob_Color'Range loop
  45       if Blob_Color (I) /= Expected_Color (I) then
  46          raise Program_Error;
  47       end if;
  48    end loop;
  49 end;