gcc/testsuite/gnat.dg/lhs_view_convert.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatp" }
   3
   4 procedure Lhs_View_Convert is
   5
   6    type Root is tagged record
   7       RV : Natural;
   8    end record;
   9
  10    type Derived is new Root with null record;
  11
  12    Root_Instance : Root := (RV => 1);
  13
  14    Derived_Instance : Derived;
  15
  16    procedure Process is
  17       X : Natural := Derived_Instance.RV;
  18    begin
  19       null;
  20    end;
  21 begin
  22    Derived_Instance.RV := 2;
  23
  24    Root (Derived_Instance) := Root (Root_Instance);
  25
  26    if Derived_Instance.RV /= Root_Instance.RV then
  27       raise Program_Error;
  28    end if;
  29 end;