Bug#589164: gnat-4.4: [Fixed in 4.5] controlled objects adjusted too often

[Ludovic Brenta <ludovic@ludovic-brenta.org>]

Package: gnat-4.4

Version: 4.4.4-4

Severity: important



(From Dmitry A. Kazakov)



with Ada.Finalization;

with Ada.Unchecked_Deallocation;

with Ada.Text_IO;



procedure Controlled_Array is

   type T is new Ada.Finalization.Limited_Controlled with record

      C : Natural := 0;

   end record;

   overriding procedure Finalize (X : in out T);



   procedure Finalize (X : in out T) is

   begin

      if X.C = 0 then

         Ada.Text_IO.Put_Line ("Successful finalization");

      else

         Ada.Text_IO.Put_Line

           ("Illegal count in finalization" & Integer'Image (X.C));

         raise Program_Error;

      end if;

   end Finalize;



   type T_Ptr is access T'Class;

   type H is new Ada.Finalization.Controlled with record

      P : T_Ptr;

   end record;

   overriding procedure Finalize (X : in out H);

   overriding procedure Adjust (X : in out H);



   procedure Finalize (X : in out H) is

      procedure Free is new Ada.Unchecked_Deallocation (T'Class, T_Ptr);

   begin

      if X.P /= null then

         X.P.C := X.P.C - 1;

         if X.P.C = 0 then

            Free (X.P);

         end if;

      end if;

   end Finalize;

   procedure Adjust (X : in out H) is

   begin

      X.P.C := X.P.C + 1;

   end Adjust;



   type H_Array is array (Positive range <>) of H;



   function Create return H is

      Result : H;

   begin

      Result.P := new T;

      Result.P.C := 1;

      return Result;

   end Create;



   List  : H_Array := (Create, Create, Create);

   First : T_Ptr := List (List'First).P;

begin

   Ada.Text_IO.Put_Line ("Count" & Integer'Image (First.C));

end Controlled_Array; 



Expected output:



   $ ./controlled_array

   Count 1

   Successful finalization

   Successful finalization

   Successful finalization 



Actual output:



Count 2

Illegal count in finalization 1 







I believe that the following patch (in GCC 4.5) fixes this:



2009-04-17 Thomas Quinot <qui...@adacore.com>



   * exp_ch7.adb (Expand_Ctrl_Function_Call): Remove incorrect special

     case for the case of an aggregate component, the attach call for the

     result is actually needed.



   * exp_aggr.adb (Backend_Processing_Possible): Backend processing for

     an array aggregate must be disabled if the component type requires

     controlled actions.



   * exp_ch3.adb: Minor reformatting 



To be backported.



-- 

Ludovic Brenta.