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/] [nested_controlled_alloc.adb] - Blame information for rev 304

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 304 jeremybenn
-- { dg-do run }
2
 
3
with Text_IO; use Text_IO;
4
with Ada.Finalization; use Ada.Finalization;
5
 
6
procedure Nested_Controlled_Alloc is
7
 
8
   package Controlled_Alloc is
9
 
10
      type Fin is new Limited_Controlled with null record;
11
      procedure Finalize (X : in out Fin);
12
 
13
      F : Fin;
14
 
15
      type T is limited private;
16
      type Ref is access all T;
17
 
18
   private
19
 
20
      type T is new Limited_Controlled with null record;
21
      procedure Finalize (X : in out T);
22
 
23
   end Controlled_Alloc;
24
 
25
   package body Controlled_Alloc is
26
 
27
       procedure Finalize (X : in out T) is
28
       begin
29
          Put_Line ("Finalize (T)");
30
       end Finalize;
31
 
32
       procedure Finalize (X : in out Fin) is
33
          R : Ref;
34
       begin
35
          begin
36
             R := new T;
37
             raise Constraint_Error;
38
 
39
          exception
40
             when Program_Error =>
41
                null;  -- OK
42
          end;
43
       end Finalize;
44
 
45
   end Controlled_Alloc;
46
 
47
begin
48
   null;
49
end Nested_Controlled_Alloc;

powered by: WebSVN 2.1.0

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