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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [discr4.adb] - Blame information for rev 801

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

Line No. Rev Author Line
1 696 jeremybenn
--  { dg-do run }
2
--  { dg-options "-gnatws" }
3
 
4
procedure discr4 is
5
   package Pkg is
6
      type Rec_Comp (D : access Integer) is record
7
         Data : Integer;
8
      end record;
9
--
10
      type I is interface;
11
      procedure Test (Obj : I) is abstract;
12
--
13
      Num : aliased Integer := 10;
14
--
15
      type Root (D : access Integer) is tagged record
16
         C1 : Rec_Comp (D);           --  test
17
      end record;
18
--
19
      type DT is new Root and I with null record;
20
--
21
      procedure Dummy (Obj : DT);
22
      procedure Test  (Obj : DT);
23
   end;
24
--
25
   package body Pkg is
26
      procedure Dummy (Obj : DT) is
27
      begin
28
         raise Program_Error;
29
      end;
30
--
31
      procedure Test (Obj : DT) is
32
      begin
33
         null;
34
      end;
35
   end;
36
--
37
   use Pkg;
38
--
39
   procedure CW_Test (Obj : I'Class) is
40
   begin
41
      Obj.Test;
42
   end;
43
--
44
   Obj : DT (Num'Access);
45
begin
46
   CW_Test (Obj);
47
end;

powered by: WebSVN 2.1.0

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