OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gnat.dg/] [iprot_test.adb] - Blame information for rev 310

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 304 jeremybenn
-- { dg-do run }
2
 
3
procedure iprot_test is
4
      type T1 is tagged  null record;
5
      package PP is
6
         protected type P is
7
            procedure S (X : T1'Class);
8
         private
9
            R2 : access T1'Class;
10
         end P;
11
      end PP;
12
      package body PP is
13
         protected body P is
14
            procedure S (X : T1'Class) is
15
            begin
16
               R2 := new T1'Class'(X);
17
               if R2 /= null then
18
                  null;
19
               end if;
20
            end S;
21
         end P;
22
      end PP;
23
      use PP;
24
      Prot : P;
25
      procedure Proc is
26
         type T2 is new T1 with null record;
27
         X2 : T2;
28
      begin
29
         Prot.S (X2);
30
      end Proc;
31
begin
32
   Proc;
33
exception
34
   when Program_Error => null;
35
end iprot_test;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.