Re: Anonymous access types are evil, why?

[Gerhard Rummel <gerhardrummel@gmail.com>]

Am Mittwoch, 28. August 2013 05:49:56 UTC-6 schrieb ake.ragna...@gmail.com:
> Consider the following application that uses anonymous access types and allocates Controlled objects on the heap using two different ways. One way takes 60 times longer than the other:
> 
> ....
> 
> 
> 
> What are the conclusions we can draw?
> 
> 1. Perhaps one conclusion would be that when using anonymous access types then indirect assignment should be preferred over direct assignment. (see Models.B.Direct_Assignment and Models.B.Indirect_Assignment).
> 
> 2. Avoid anonymous access types. Prefer named access types and 'Unchecked_Access.
> 
> 
> 
> Is there anybody who can explain why direct assignment takes approximately 60 times longer than indirect assignment?
> 
> 
> 
> Best regards,
> 
> Åke Ragnar Dahlgren

I think there is a problem with the implementation of Controlled Types in
gnat2012, and NOT with anonymous access types: if you change the declaration of A_Type to a not controlled record there is nearly no difference in runtime: To show that I have declared three versions of your A_Type (in Models.A): as a record, a tagged record and as derived from Ada.Finalization.Controlled. Then I declared six versions of your B_Type, with anonymous and named access variables of each of the three types. Additionally, I cleaned up the heap before the direct or indirect assignments.

The output of the Main program is now:


Output:

Heap clean up before assignment: TRUE
MODELS.B.TYPE_WITH_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.005783000
MODELS.B.TYPE_WITH_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.002435000
MODELS.B.TYPE_WITH_ANONYMOUS_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.002283000
MODELS.B.TYPE_WITH_ANONYMOUS_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.002263000
MODELS.B.TYPE_WITH_TAGGED_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.002298000
MODELS.B.TYPE_WITH_TAGGED_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.002263000
MODELS.B.TYPE_WITH_ANONYMOUS_TAGGED_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.002304000
MODELS.B.TYPE_WITH_ANONYMOUS_TAGGED_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.002553000
MODELS.B.TYPE_WITH_CONTROLLED_ACCESS_TYPE, Duration (direct assignment):    0.005504000
MODELS.B.TYPE_WITH_CONTROLLED_ACCESS_TYPE, Duration (indirect assignment):  0.005505000
MODELS.B.TYPE_WITH_ANONYMOUS_CONTROLLED_ACCESS_TYPE, Duration (direct assignment):    0.010914000
MODELS.B.TYPE_WITH_ANONYMOUS_CONTROLLED_ACCESS_TYPE, Duration (indirect assignment):  0.005706000


As you can see, the quotient of the runtimes of the two methods of assignments is now a factor less than two, if your A_Type is Controlled and more than two, if your A_Type is a simple record instead of a Controlled type.

Things are much worse for Controlled types when you don't clean up the heap before the assignments:


Output:

Heap clean up before assignment: FALSE
MODELS.B.TYPE_WITH_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.066929000
MODELS.B.TYPE_WITH_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.063081000
MODELS.B.TYPE_WITH_ANONYMOUS_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.063031000
MODELS.B.TYPE_WITH_ANONYMOUS_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.062613000
MODELS.B.TYPE_WITH_TAGGED_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.062416000
MODELS.B.TYPE_WITH_TAGGED_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.062329000
MODELS.B.TYPE_WITH_ANONYMOUS_TAGGED_RECORD_ACCESS_TYPE, Duration (direct assignment):    0.061632000
MODELS.B.TYPE_WITH_ANONYMOUS_TAGGED_RECORD_ACCESS_TYPE, Duration (indirect assignment):  0.062526000
MODELS.B.TYPE_WITH_CONTROLLED_ACCESS_TYPE, Duration (direct assignment):    0.064492000
MODELS.B.TYPE_WITH_CONTROLLED_ACCESS_TYPE, Duration (indirect assignment):  0.064068000
MODELS.B.TYPE_WITH_ANONYMOUS_CONTROLLED_ACCESS_TYPE, Duration (direct assignment):    11.441936000
MODELS.B.TYPE_WITH_ANONYMOUS_CONTROLLED_ACCESS_TYPE, Duration (indirect assignment):  0.063594000

In the last four lines you can see that the runtimes for the two methods of assignments are nearly equal for a B_Type with a named access type variable of a Controlled type and very different for anonymous access type variables.

I think there is no important performance difference between anonymous and named access variables if you clean up the heap before assigning new values to them. But there is a problem with the finalization of Controlled type variables on the heap, perhaps due to their implementation in gnat 2012.

The code of the program:

with Ada.Text_IO;
with Models.B;

procedure Main is

   Number_Of_Times : constant Positive := 40000;

begin
   for B in reverse Boolean range False .. True loop
      declare
         RT : Models.B.Type_With_Record_Access_Type;
         ART : Models.B.Type_With_Anonymous_Record_Access_Type;
         TRT : Models.B.Type_With_Tagged_Record_Access_Type;
         ATRT : Models.B.Type_With_Anonymous_Tagged_Record_Access_Type;
         CT : Models.B.Type_With_Controlled_Access_Type;
         ACT : Models.B.Type_With_Anonymous_Controlled_Access_Type;
      begin
         Models.B.With_Heap_Cleaning := B;
         Ada.Text_IO.Put_Line
           (Item => "Heap clean up before assignment: "
            & Boolean'Image (Models.B.With_Heap_Cleaning)
           );
         RT.Measure_Time (Number_Of_Times => Number_Of_Times);
         ART.Measure_Time (Number_Of_Times => Number_Of_Times);
         TRT.Measure_Time (Number_Of_Times => Number_Of_Times);
         ATRT.Measure_Time (Number_Of_Times => Number_Of_Times);
         CT.Measure_Time (Number_Of_Times => Number_Of_Times);
         ACT.Measure_Time (Number_Of_Times => Number_Of_Times);
         Ada.Text_IO.New_Line;
      end;
   end loop;
end Main;

package Models is

end Models;

with Ada.Finalization;
with Ada.Unchecked_Deallocation;
package Models.A is

   type Record_Type is record
      Asdf : Integer;
      qwer : String (1 .. 8000);
   end record;

   type Record_Access_Type is access all Record_Type;

   procedure Delete is new Ada.Unchecked_Deallocation
     (Object => Record_Type, Name => Record_Access_Type);

   type Tagged_Record_Type is tagged record
      Asdf : Integer;
      qwer : String (1 .. 8000);
   end record;

   type Tagged_Record_Access_Type is access all Tagged_Record_Type;

   procedure Delete is new Ada.Unchecked_Deallocation
     (Object => Tagged_Record_Type, Name => Tagged_Record_Access_Type);

   type Controlled_Type is new Ada.Finalization.Controlled with
      record
         Asdf : Integer;
         qwer : String (1 .. 8000);
      end record;

   type Controlled_Access_Type is access all Controlled_Type;

   procedure Delete is new Ada.Unchecked_Deallocation
     (Object => Controlled_Type, Name => Controlled_Access_Type);

end Models.A;

with Ada.Finalization,
     Models.A;

package Models.B is

   With_Heap_Cleaning : Boolean := False;

   type Type_With_Access_Type is abstract new Ada.Finalization.Controlled
     with private;

   overriding
   procedure Finalize (Item : in out Type_With_Access_Type) with Inline;

   function Type_Name (Item : Type_With_Access_Type'Class) return String
   with Inline;

   procedure Cleanup (Item : in out Type_With_Access_Type) is abstract;

   procedure Direct_Assignment (Item : in out Type_With_Access_Type)
   is abstract;

   procedure Indirect_Assignment (Item : in out Type_With_Access_Type)
   is abstract;

   procedure Measure_Time
     (Item : in out Type_With_Access_Type'Class;
      Number_Of_Times : Natural
     );

   ----------------------------------------------------------------------------

   type Type_With_Record_Access_Type is new Type_With_Access_Type with private;

   overriding
   procedure Adjust (Item : in out Type_With_Record_Access_Type) with Inline;

   overriding
   procedure Cleanup (Item : in out Type_With_Record_Access_Type);

   overriding
   procedure Direct_Assignment (Item : in out Type_With_Record_Access_Type)
   with Inline;

   overriding
   procedure Indirect_Assignment (Item : in out Type_With_Record_Access_Type)
   with Inline;

   ----------------------------------------------------------------------------

   type Type_With_Anonymous_Record_Access_Type is new Type_With_Access_Type
     with private;

   overriding
   procedure Adjust (Item : in out Type_With_Anonymous_Record_Access_Type)
   with Inline;

   overriding
   procedure Cleanup (Item : in out Type_With_Anonymous_Record_Access_Type);

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Record_Access_Type) with Inline;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Record_Access_Type) with Inline;

   ----------------------------------------------------------------------------

   type Type_With_Tagged_Record_Access_Type is new Type_With_Access_Type
     with private;

   overriding
   procedure Adjust (Item : in out Type_With_Tagged_Record_Access_Type)
   with Inline;

   overriding
   procedure Cleanup (Item : in out Type_With_Tagged_Record_Access_Type);

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Tagged_Record_Access_Type) with Inline;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Tagged_Record_Access_Type) with Inline;

   ----------------------------------------------------------------------------

   type Type_With_Anonymous_Tagged_Record_Access_Type is
     new Type_With_Access_Type with private;

   overriding
   procedure Adjust
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type) with Inline;

   overriding
   procedure Cleanup
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type);

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type) with Inline;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type) with Inline;

   ----------------------------------------------------------------------------

   type Type_With_Controlled_Access_Type is new Type_With_Access_Type
     with private;

   overriding
   procedure Adjust (Item : in out Type_With_Controlled_Access_Type)
   with Inline;

   overriding
   procedure Cleanup (Item : in out Type_With_Controlled_Access_Type);

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Controlled_Access_Type) with Inline;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Controlled_Access_Type) with Inline;

   ----------------------------------------------------------------------------

   type Type_With_Anonymous_Controlled_Access_Type is new Type_With_Access_Type
     with private;

   overriding
   procedure Adjust (Item : in out Type_With_Anonymous_Controlled_Access_Type)
   with Inline;

   overriding
   procedure Cleanup
     (Item : in out Type_With_Anonymous_Controlled_Access_Type);

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Controlled_Access_Type) with Inline;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Controlled_Access_Type) with Inline;

private

   type Type_With_Access_Type is abstract new Ada.Finalization.Controlled
     with null record;

   type Type_With_Record_Access_Type is new Type_With_Access_Type with record
      A : Models.A.Record_Access_Type;
   end record;

   type Type_With_Anonymous_Record_Access_Type is new Type_With_Access_Type
   with record
      A : access Models.A.Record_Type;
   end record;

   type Type_With_Tagged_Record_Access_Type is new Type_With_Access_Type
   with record
      A : Models.A.Tagged_Record_Access_Type;
   end record;

   type Type_With_Anonymous_Tagged_Record_Access_Type is
     new Type_With_Access_Type with record
      A : access Models.A.Tagged_Record_Type;
   end record;

   type Type_With_Controlled_Access_Type is new Type_With_Access_Type
   with record
      A : Models.A.Controlled_Access_Type;
   end record;

   type Type_With_Anonymous_Controlled_Access_Type is new Type_With_Access_Type
   with record
      A : access Models.A.Controlled_Type;
   end record;

end Models.B;

with Ada.Real_Time;
with Ada.Tags;
with Ada.Text_IO;
package body Models.B is

   overriding
   procedure Finalize (Item : in out Type_With_Access_Type)
   is
   begin
      Type_With_Access_Type'Class (Item).Cleanup;
   end Finalize;

   function Type_Name (Item : Type_With_Access_Type'Class) return String
   is
   begin
      return Ada.Tags.External_Tag (T => Item'Tag);
   end Type_Name;

   procedure Measure_Time
     (Item : in out Type_With_Access_Type'Class;
      Number_Of_Times : Natural
     )
   is
      Start_Time_Stamp : Ada.Real_Time.Time;
      End_Time_Stamp   : Ada.Real_Time.Time;
   begin
      Start_Time_Stamp := Ada.Real_Time.Clock;
      for I in 1 .. Number_Of_Times loop
         Item.Direct_Assignment;
      end loop;
      End_Time_Stamp := Ada.Real_Time.Clock;

      declare
         use type Ada.Real_Time.Time;

         Total_Time : constant Duration
           := Ada.Real_Time.To_Duration (End_Time_Stamp - Start_Time_Stamp);
      begin
         Ada.Text_IO.Put_Line
           (Item.Type_Name
            & ", Duration (direct assignment):   " & Total_Time'Img
           );
      end;

      Start_Time_Stamp := Ada.Real_Time.Clock;
      for I in 1 .. Number_Of_Times loop
         Item.Indirect_Assignment;
      end loop;
      End_Time_Stamp := Ada.Real_Time.Clock;

      declare
         use type Ada.Real_Time.Time;

         Total_Time : constant Duration
           := Ada.Real_Time.To_Duration (End_Time_Stamp - Start_Time_Stamp);
      begin
         Ada.Text_IO.Put_Line
           (Item.Type_Name
            & ", Duration (indirect assignment): " & Total_Time'Img
           );
      end;

   end Measure_Time;

   ----------------------------------------------------------------------------

   overriding
   procedure Adjust (Item : in out Type_With_Record_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Record_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup (Item : in out Type_With_Record_Access_Type)
   is
      use Models.A;
      X : Models.A.Record_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment (Item : in out Type_With_Record_Access_Type) is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Record_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment (Item : in out Type_With_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Record_Access_Type := new Models.A.Record_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

   ---------------------------------------------------------------------------

   overriding
   procedure Adjust (Item : in out Type_With_Anonymous_Record_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Record_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup (Item : in out Type_With_Anonymous_Record_Access_Type)
   is
      use Models.A;
      X : Models.A.Record_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Record_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Record_Access_Type := new Models.A.Record_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

   ---------------------------------------------------------------------------

   overriding
   procedure Adjust (Item : in out Type_With_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Tagged_Record_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup (Item : in out Type_With_Tagged_Record_Access_Type)
   is
      use Models.A;
      X : Models.A.Tagged_Record_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Tagged_Record_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Tagged_Record_Access_Type
           := new Models.A.Tagged_Record_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

   ---------------------------------------------------------------------------

   overriding
   procedure Adjust
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Tagged_Record_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type)
   is
      use Models.A;
      X : Models.A.Tagged_Record_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Tagged_Record_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Tagged_Record_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Tagged_Record_Access_Type
           := new Models.A.Tagged_Record_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

   ---------------------------------------------------------------------------

   overriding
   procedure Adjust (Item : in out Type_With_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Controlled_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup (Item : in out Type_With_Controlled_Access_Type)
   is
      use Models.A;
      X : Models.A.Controlled_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment (Item : in out Type_With_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Controlled_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Controlled_Access_Type
           := new Models.A.Controlled_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

   ---------------------------------------------------------------------------

   overriding
   procedure Adjust (Item : in out Type_With_Anonymous_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if Item.A /= null then
         Item.A := new Models.A.Controlled_Type'(Item.A.all);
      end if;
   end Adjust;

   overriding
   procedure Cleanup
     (Item : in out Type_With_Anonymous_Controlled_Access_Type)
   is
      use Models.A;
      X : Models.A.Controlled_Access_Type := Item.A;
   begin
      Item.A := null;
      if X /= null then
         Delete (X);
      end if;
   end Cleanup;

   overriding
   procedure Direct_Assignment
     (Item : in out Type_With_Anonymous_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      Item.A := new Models.A.Controlled_Type;
   end Direct_Assignment;

   overriding
   procedure Indirect_Assignment
     (Item : in out Type_With_Anonymous_Controlled_Access_Type)
   is
      use Models.A;
   begin
      if With_Heap_Cleaning then
         Item.Cleanup;
      end if;

      declare
         A : constant Models.A.Controlled_Access_Type
           := new Models.A.Controlled_Type;
      begin
         Item.A := A;
      end;
   end Indirect_Assignment;

end Models.B;