gcc/testsuite/gnat.dg/sso/conv1.adb

   1 -- { dg-do run }
   2
   3 with System; use System;
   4 with Ada.Text_IO; use Ada.Text_IO;
   5
   6 procedure Conv1 is
   7    type Short is mod 2**16;
   8
   9    type R_L is record
  10       S : Short;
  11       C : Character;
  12    end record;
  13    for R_L'Bit_Order use Low_Order_First;
  14    for R_L'Scalar_Storage_Order use Low_Order_First;
  15    for R_L use record
  16       S at 0 range 0 .. 15;
  17       C at 2 range 0 .. 7;
  18    end record;
  19
  20    type R_H is new R_L;
  21    for R_H'Bit_Order use High_Order_First;
  22    for R_H'Scalar_Storage_Order use High_Order_First;
  23    for R_H use record
  24       S at 0 range 0 .. 15;
  25       C at 2 range 0 .. 7;
  26    end record;
  27
  28    procedure Dump (Name : String; S : Short; C : Character) is
  29    begin
  30       Put_Line (Name & " = (S =>" & S'Img & ", C => '" & C & "')");
  31    end Dump;
  32
  33    X_L : R_L;
  34    X_H : R_H;
  35 begin
  36    X_L.S := 12345;
  37    X_L.C := 'a';
  38    Dump ("X_L", X_L.S, X_L.C);
  39    -- { dg-output "X_L = \\(S => 12345, C => 'a'\\).*\n" }
  40
  41    X_H.S := 23456;
  42    X_H.C := 'b';
  43    Dump ("X_H", X_H.S, X_H.C);
  44    -- { dg-output "X_H = \\(S => 23456, C => 'b'\\).*\n" }
  45
  46    X_H := R_H (X_L);
  47    Dump ("X_H", X_H.S, X_H.C);
  48    -- { dg-output "X_H = \\(S => 12345, C => 'a'\\).*\n" }
  49
  50 end;