2018-03-15 Steven G. Kargl <kargl@gcc.gnu.org>
[official-gcc.git] / gcc / testsuite / gnat.dg / sso3.adb
blobd4b65697a1b96067d54ca2deead136bb8fa011de
1 -- { dg-do run }
3 with System; use System;
5 procedure SSO3 is
6 Rev_SSO : constant Bit_Order
7 := Bit_Order'Val (1 - Bit_Order'Pos (Default_Bit_Order));
9 type R (D : Integer) is record
10 Common : Integer;
11 case D is
12 when 0 =>
13 V1 : Integer;
14 when others =>
15 V2 : Integer;
16 end case;
17 end record;
19 for R use record
20 D at 0 range 0 .. 31;
21 V1 at 4 range 0 .. 31;
22 V2 at 4 range 0 .. 31;
23 Common at 8 range 0 .. 31;
24 end record;
25 for R'Scalar_Storage_Order use Rev_SSO;
26 for R'Bit_Order use Rev_SSO;
28 procedure Check (Common, V : Integer; X : R) is
29 begin
30 if Common /= X.Common then
31 raise Program_Error;
32 end if;
34 case X.D is
35 when 0 =>
36 if V /= X.V1 then
37 raise Program_Error;
38 end if;
39 when others =>
40 if V /= X.V2 then
41 raise Program_Error;
42 end if;
43 end case;
44 end Check;
46 X0 : R := (D => 0, Common => 1111, V1 => 1234);
47 X1 : R := (D => 31337, Common => 2222, V2 => 5678);
49 begin
50 Check (1111, 1234, X0);
51 Check (2222, 5678, X1);
52 end;