URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Only display areas with differences |
Details |
Blame |
View Log
Rev 304 |
Rev 384 |
-- { 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;
|
|
|
© copyright 1999-2024
OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.