Subversion Repositories openrisc

--  { dg-do run }

--  { dg-do run }

--  { dg-options "-gnatws" }

--  { dg-options "-gnatws" }

procedure discr4 is

procedure discr4 is

   package Pkg is

   package Pkg is

      type Rec_Comp (D : access Integer) is record

      type Rec_Comp (D : access Integer) is record

         Data : Integer;

         Data : Integer;

      end record;

      end record;

--

--

      type I is interface;

      type I is interface;

      procedure Test (Obj : I) is abstract;

      procedure Test (Obj : I) is abstract;

--

--

      Num : aliased Integer := 10;

      Num : aliased Integer := 10;

--

--

      type Root (D : access Integer) is tagged record

      type Root (D : access Integer) is tagged record

         C1 : Rec_Comp (D);           --  test

         C1 : Rec_Comp (D);           --  test

      end record;

      end record;

--

--

      type DT is new Root and I with null record;

      type DT is new Root and I with null record;

--

--

      procedure Dummy (Obj : DT);

      procedure Dummy (Obj : DT);

      procedure Test  (Obj : DT);

      procedure Test  (Obj : DT);

   end;

   end;

--

--

   package body Pkg is

   package body Pkg is

      procedure Dummy (Obj : DT) is

      procedure Dummy (Obj : DT) is

      begin

      begin

         raise Program_Error;

         raise Program_Error;

      end;

      end;

--

--

      procedure Test (Obj : DT) is

      procedure Test (Obj : DT) is

      begin

      begin

         null;

         null;

      end;

      end;

   end;

   end;

--

--

   use Pkg;

   use Pkg;

--

--

   procedure CW_Test (Obj : I'Class) is

   procedure CW_Test (Obj : I'Class) is

   begin

   begin

      Obj.Test;

      Obj.Test;

   end;

   end;

--

--

   Obj : DT (Num'Access);

   Obj : DT (Num'Access);

begin

begin

   CW_Test (Obj);

   CW_Test (Obj);

end;

end;