RISC-V: Add support for riscv-*-*.
[official-gcc.git] / gcc / testsuite / gnat.dg / nested_controlled_alloc.adb
blob963ba76be9718d72f50d69667d87b36008df69f4
1 -- { dg-do run }
3 with Text_IO; use Text_IO;
4 with Ada.Finalization; use Ada.Finalization;
6 procedure Nested_Controlled_Alloc is
8 package Controlled_Alloc is
10 type Fin is new Limited_Controlled with null record;
11 procedure Finalize (X : in out Fin);
13 F : Fin;
15 type T is limited private;
16 type Ref is access all T;
18 private
20 type T is new Limited_Controlled with null record;
21 procedure Finalize (X : in out T);
23 end Controlled_Alloc;
25 package body Controlled_Alloc is
27 procedure Finalize (X : in out T) is
28 begin
29 Put_Line ("Finalize (T)");
30 end Finalize;
32 procedure Finalize (X : in out Fin) is
33 R : Ref;
34 begin
35 begin
36 R := new T;
37 raise Constraint_Error;
39 exception
40 when Program_Error =>
41 null; -- OK
42 end;
43 end Finalize;
45 end Controlled_Alloc;
47 begin
48 null;
49 end Nested_Controlled_Alloc;