gcc/testsuite/gnat.dg/renaming2.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnatws" }
   3
   4 with Text_IO;
   5 procedure renaming2 is
   6     type RealNodeData;
   7     type RefRealNodeData is access RealNodeData;
   8
   9     type ExpressionEntry;
  10     type RefExpression is access ExpressionEntry;
  11
  12     type RefDefUseEntry is access Natural;
  13
  14     type ExpressionEntry is
  15     record
  16         Number : RefDefUseEntry;
  17         Id     : Integer;
  18     end record;
  19
  20     type RealNodeData is
  21     record
  22         Node   : RefExpression;
  23         Id     : Integer;
  24     end record;
  25
  26     for ExpressionEntry use
  27     record
  28         Number at 0 range  0 .. 63;
  29         Id     at 8 range  0 .. 31;
  30     end record ;
  31
  32     for RealNodeData use
  33     record
  34         Node   at  0 range  0 .. 63;
  35         Id     at 8 range  0 .. 31;
  36     end record ;
  37
  38     U_Node : RefDefUseEntry := new Natural'(1);
  39     E_Node : RefExpression := new ExpressionEntry'(Number => U_Node,
  40                                                    Id => 2);
  41     R_Node : RefRealNodeData := new RealNodeData'(Node => E_Node,
  42                                                    Id => 3);
  43
  44     procedure test_routine (NodeRealData : RefRealNodeData)
  45     is
  46         OldHead   : RefDefUseEntry renames NodeRealData.all.Node.all.Number;
  47         OldHead1  : constant RefDefUseEntry := OldHead;
  48     begin
  49       NodeRealData.all.Node := new ExpressionEntry'(Number => null, Id => 4);
  50       declare
  51         OldHead2 : constant RefDefUseEntry := OldHead;
  52       begin
  53         if OldHead1 /= OldHead2
  54         then
  55           Text_IO.Put_Line (" OldHead changed !!!");
  56         end if;
  57       end;
  58     end;
  59 begin
  60   test_routine (R_Node);
  61 end;