gcc/testsuite/gnat.dg/sso14.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnatws" }
   3
   4 with System;
   5 with Ada.Unchecked_Conversion;
   6
   7 procedure SSO14 is
   8
   9    type Arr is array (1 .. Integer'Size) of Boolean;
  10    pragma Pack (Arr);
  11    for Arr'Scalar_Storage_Order use System.High_Order_First;
  12
  13    function From_Float is new Ada.Unchecked_Conversion (Float, Arr);
  14    function From_Int is new Ada.Unchecked_Conversion (Integer, Arr);
  15
  16    type R_Float is record
  17      F : Float;
  18    end record;
  19    for R_Float'Bit_Order use System.High_Order_First;
  20    for R_Float'Scalar_Storage_Order use System.High_Order_First;
  21
  22    type R_Int is record
  23      I : Integer;
  24    end record;
  25    for R_Int'Bit_Order use System.High_Order_First;
  26    for R_Int'Scalar_Storage_Order use System.High_Order_First;
  27
  28    F1 : Float := 1.234567;
  29    FA : Arr;
  30    F2 : R_Float;
  31    for F2'Address use FA'Address;
  32    pragma Import (Ada, F2);
  33
  34    I1 : Integer := 1234567;
  35    IA : Arr;
  36    I2 : R_Int;
  37    for I2'Address use IA'Address;
  38    pragma Import (Ada, I2);
  39
  40 begin
  41    -- Check that converting a FP value yields a big-endian array
  42    FA := From_Float (F1);
  43    if F2.F /= F1 then
  44       raise Program_Error;
  45    end if;
  46
  47    -- Check that converting an integer value yields a big-endian array.
  48    IA := From_Int (I1);
  49    if I2.I /= I1 then
  50       raise Program_Error;
  51    end if;
  52 end;