URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Go to most recent revision |
Only display areas with differences |
Details |
Blame |
View Log
| Rev 304 |
Rev 338 |
-- { dg-do run }
|
-- { dg-do run }
|
|
|
procedure iprot_test is
|
procedure iprot_test is
|
type T1 is tagged null record;
|
type T1 is tagged null record;
|
package PP is
|
package PP is
|
protected type P is
|
protected type P is
|
procedure S (X : T1'Class);
|
procedure S (X : T1'Class);
|
private
|
private
|
R2 : access T1'Class;
|
R2 : access T1'Class;
|
end P;
|
end P;
|
end PP;
|
end PP;
|
package body PP is
|
package body PP is
|
protected body P is
|
protected body P is
|
procedure S (X : T1'Class) is
|
procedure S (X : T1'Class) is
|
begin
|
begin
|
R2 := new T1'Class'(X);
|
R2 := new T1'Class'(X);
|
if R2 /= null then
|
if R2 /= null then
|
null;
|
null;
|
end if;
|
end if;
|
end S;
|
end S;
|
end P;
|
end P;
|
end PP;
|
end PP;
|
use PP;
|
use PP;
|
Prot : P;
|
Prot : P;
|
procedure Proc is
|
procedure Proc is
|
type T2 is new T1 with null record;
|
type T2 is new T1 with null record;
|
X2 : T2;
|
X2 : T2;
|
begin
|
begin
|
Prot.S (X2);
|
Prot.S (X2);
|
end Proc;
|
end Proc;
|
begin
|
begin
|
Proc;
|
Proc;
|
exception
|
exception
|
when Program_Error => null;
|
when Program_Error => null;
|
end iprot_test;
|
end iprot_test;
|
|
|
© copyright 1999-2024
OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.