Subversion Repositories openrisc

-- { dg-do run }

-- { dg-do run }

with Text_IO; use Text_IO;

with Text_IO; use Text_IO;

with Ada.Finalization; use Ada.Finalization;

with Ada.Finalization; use Ada.Finalization;

procedure Nested_Controlled_Alloc is

procedure Nested_Controlled_Alloc is

   package Controlled_Alloc is

   package Controlled_Alloc is

      type Fin is new Limited_Controlled with null record;

      type Fin is new Limited_Controlled with null record;

      procedure Finalize (X : in out Fin);

      procedure Finalize (X : in out Fin);

      F : Fin;

      F : Fin;

      type T is limited private;

      type T is limited private;

      type Ref is access all T;

      type Ref is access all T;

   private

   private

      type T is new Limited_Controlled with null record;

      type T is new Limited_Controlled with null record;

      procedure Finalize (X : in out T);

      procedure Finalize (X : in out T);

   end Controlled_Alloc;

   end Controlled_Alloc;

   package body Controlled_Alloc is

   package body Controlled_Alloc is

       procedure Finalize (X : in out T) is

       procedure Finalize (X : in out T) is

       begin

       begin

          Put_Line ("Finalize (T)");

          Put_Line ("Finalize (T)");

       end Finalize;

       end Finalize;

       procedure Finalize (X : in out Fin) is

       procedure Finalize (X : in out Fin) is

          R : Ref;

          R : Ref;

       begin

       begin

          begin

          begin

             R := new T;

             R := new T;

             raise Constraint_Error;

             raise Constraint_Error;

          exception

          exception

             when Program_Error =>

             when Program_Error =>

                null;  -- OK

                null;  -- OK

          end;

          end;

       end Finalize;

       end Finalize;

   end Controlled_Alloc;

   end Controlled_Alloc;

begin

begin

   null;

   null;

end Nested_Controlled_Alloc;

end Nested_Controlled_Alloc;