built-in-place bug of gcc-4.7

alloc.adb

function alloc return access lifetime.T is
begin
   return new lifetime.T'(lifetime.Create);
   -- lifetime.Finalize may be called here
end alloc;

alloc.ads

with lifetime;
function alloc return access lifetime.T;

bip_and_finalize.adb

with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with lifetime;
with alloc;
procedure bip_and_finalize is
begin
   Ada.Text_IO.Put_Line ("before");
   declare
      type A is access all lifetime.T;
      procedure Free is new Ada.Unchecked_Deallocation (lifetime.T, A);
      P : A := A(alloc);
   begin
      -- P.all may be already finalized!!!
      Ada.Text_IO.Put_Line ("lifetime");
      Free (P); -- lifetime.Finalize may be called, once again
   end;
   Ada.Text_IO.Put_Line ("after");
end bip_and_finalize;
-- % gnatmake -gnat2012 bip_and_finalize.adb && ./bip_and_finalize
-- before
-- Initialize (0000000100100090)
-- Finalize (0000000100100090) <- !!!!
-- lifetime
-- Finalize (0000000100100090)
-- after

lifetime.adb

with Ada.Text_IO;
with System.Address_Image;
package body lifetime is

   procedure Finalize (Object : in out T) is
   begin
      Ada.Text_IO.Put_Line ("Finalize (" & System.Address_Image (Object'Address) & ")");
   end Finalize;

   function Create return T is
   begin
      return Result : T := (Ada.Finalization.Limited_Controlled with null record) do
         Ada.Text_IO.Put_Line ("Initialize (" & System.Address_Image (Result'Address) & ")");
      end return;
   end Create;

end lifetime;

lifetime.ads

with Ada.Finalization;
package lifetime is

   type T is limited private;

   function Create return T;

private

   type T is limited new Ada.Finalization.Limited_Controlled with null record;

   overriding procedure Finalize (Object : in out T);

end lifetime;