mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
50 lines
1021 B
Ada
50 lines
1021 B
Ada
-- { dg-do run }
|
|
|
|
with Text_IO; use Text_IO;
|
|
with Ada.Finalization; use Ada.Finalization;
|
|
|
|
procedure Nested_Controlled_Alloc is
|
|
|
|
package Controlled_Alloc is
|
|
|
|
type Fin is new Limited_Controlled with null record;
|
|
procedure Finalize (X : in out Fin);
|
|
|
|
F : Fin;
|
|
|
|
type T is limited private;
|
|
type Ref is access all T;
|
|
|
|
private
|
|
|
|
type T is new Limited_Controlled with null record;
|
|
procedure Finalize (X : in out T);
|
|
|
|
end Controlled_Alloc;
|
|
|
|
package body Controlled_Alloc is
|
|
|
|
procedure Finalize (X : in out T) is
|
|
begin
|
|
Put_Line ("Finalize (T)");
|
|
end Finalize;
|
|
|
|
procedure Finalize (X : in out Fin) is
|
|
R : Ref;
|
|
begin
|
|
begin
|
|
R := new T;
|
|
raise Constraint_Error;
|
|
|
|
exception
|
|
when Program_Error =>
|
|
null; -- OK
|
|
end;
|
|
end Finalize;
|
|
|
|
end Controlled_Alloc;
|
|
|
|
begin
|
|
null;
|
|
end Nested_Controlled_Alloc;
|