gcc/testsuite/gnat.dg/tfren.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnatws" }
   3
   4 procedure Tfren is
   5    type R;
   6    type Ar is access all R;
   7    type R is record F1: Integer; F2: Ar; end record;
   8
   9    for R use record
  10       F1 at 1 range 0..31;
  11      F2 at 5 range 0..63;
  12    end record;
  13
  14    procedure Foo (RR1, RR2: Ar);
  15
  16    procedure Foo (RR1, RR2 : Ar) is
  17    begin
  18       if RR2.all.F1 /= 55 then raise program_error; end if;
  19    end;
  20
  21    R3: aliased R := (55, Null);
  22    R2: aliased R := (44, R3'Access);
  23    R1: aliased R := (22, R2'Access);
  24    P: Ar := R1'Access;
  25
  26    X: Ar renames P.all.F2;
  27    Y: Ar renames X.all.F2;
  28
  29 begin
  30    P := R2'Access;
  31    R1.F2 := R1'Access;
  32    Foo (X, Y);
  33    Y.F1 := -111;
  34    if Y.F1 /= -111 then raise Constraint_Error; end if;
  35 end Tfren;