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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [discr30.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
-- PR ada/48844
2
-- Reported by Georg Bauhaus <bauhaus@futureapps.de> */
3
 
4
-- { dg-do compile }
5
 
6
procedure Discr30 is
7
 
8
   generic
9
     type Source is private;
10
     type Target is private;
11
   function Conversion (S : Source) return Target;
12
 
13
   function Conversion (S : Source) return Target is
14
      type Source_Wrapper is tagged record
15
         S : Source;
16
      end record;
17
      type Target_Wrapper is tagged record
18
         T : Target;
19
      end record;
20
 
21
      type Selector is (Source_Field, Target_Field);
22
      type Magic (Sel : Selector := Target_Field) is record
23
         case Sel is
24
            when Source_Field => S : Source_Wrapper;
25
            when Target_Field => T : Target_Wrapper;
26
         end case;
27
      end record;
28
 
29
      M : Magic;
30
 
31
      function Convert (T : Target_Wrapper) return Target is
32
      begin
33
         M := (Sel => Source_Field, S => (S => S));
34
         return T.T;
35
      end Convert;
36
 
37
   begin
38
      return Convert (M.T);
39
   end Conversion;
40
 
41
   type Integer_Access is access all Integer;
42
 
43
   I : aliased Integer;
44
   I_Access : Integer_Access := I'Access;
45
 
46
   function Convert is new Conversion (Integer_Access, Integer);
47
 
48
begin
49
   I := Convert (I_Access);
50
end;

powered by: WebSVN 2.1.0

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