Anonymous access types are evil, why?

Anonymous access types are evil, why?

[ake.ragnar.dahlgren]

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:

C:\huge_performance_problem>C:\huge_performance_problem\obj\main
Duration:  3.306827264
Duration:  0.056302128

C:\huge_performance_problem>

Please review the code:

-- main.adb:

with Ada.Text_IO,
     Models.A,
     Models.B,
     Ada.Real_Time;

procedure Main is

   Number_Of_Times : Positive := 40000;

   type Method_Pointer_Type is access procedure (B : in out Models.B.B_Type);
   
   procedure Measure_Time (Method : Method_Pointer_Type)
   is
      B : Models.B.B_Type;
      
      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
         Method(B);
      end loop;
      End_Time_Stamp := Ada.Real_Time.Clock;
   
      declare
         use type Ada.Real_Time.Time;
         
         Total_Time : Duration := Ada.Real_Time.To_Duration (End_Time_Stamp - Start_Time_Stamp);
      begin
         Ada.Text_IO.Put_Line ("Duration: " & Total_Time'Img);
      end;
   end Measure_Time;
      
begin
   Measure_Time(Method => Models.B.Direct_Assignment'Access);
   Measure_Time(Method => Models.B.Indirect_Assignment'Access);
end Main;



-- models.ads:

package Models is
      
end Models;



-- models.a.ads:

with Ada.Finalization;

package Models.A is

   type A_Type is new Ada.Finalization.Controlled with
      record
         Asdf : Integer;
         qwer : String(1..8000);
      end record;
   
   type A_Access_Type is access all A_Type;
   
end Models.A;



-- models.b.ads:

with Ada.Finalization,
     Models.A;

package Models.B is

   type B_Type is new Ada.Finalization.Controlled with
      record
         A : access Models.A.A_Type;
      end record;
   
   procedure Direct_Assignment (B : in out B_Type);
   procedure Indirect_Assignment (B : in out B_Type);
   
   type B_Access_Type is access all B_Type;
   
end Models.B;



-- models.b.adb:

with Ada.Text_IO;

package body Models.B is

   procedure Direct_Assignment(B : in out B_Type) is
   begin
      B.A := new Models.A.A_Type;
   end Direct_Assignment;
   
   procedure Indirect_Assignment (B : in out B_Type) is
   begin
      declare
         A : Models.A.A_Access_Type := new Models.A.A_Type;
      begin
         B.A := A;            
      end;
   end Indirect_Assignment;
      
end Models.B;



Now consider the case when the declaration of B_Type is changed to a named access type:
   type B_Type is new Ada.Finalization.Controlled with
      record
         A : Models.A.A_Access_Type;
      end record;

The execution times are now roughly the same:

C:\huge_performance_problem>C:\huge_performance_problem\obj\main
Duration:  0.055985048
Duration:  0.058163538

C:\huge_performance_problem>

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

Re: Anonymous access types are evil, why?

[Adam Beneschan]

On Wednesday, August 28, 2013 4:49:56 AM UTC-7, ake.ragna...@gmail.com wrote:
> 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:

[rest snipped]

I get the same results with GNAT 2012, but not GNAT 2011.  Also, there were some rule changes in Ada 2012 with respect to allocators whose type is an anonymous access type, which is what you're dealing with when you assign B.A in Direct_Assignment.  A cursory reading of 3.10.2(14/3) makes me think that none of the rule changes should apply in this case, but I don't know.  (Yes, I'm aware that "cursory reading" and "3.10.2" should never appear together in the same sentence.)  So I'd guess that the overhead is due to the way GNAT changed its implementation to deal with the new rules.  Whether it did so correctly or not, I can't say.  I'm not familiar enough with the ramifications of the new rules to have any idea what kind of implementation overhead they may require, and I'm not a GNAT developer in any case.


> 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).

More the the point, this probably means "an allocator whose type is a named access type should be preferred over an allocator whose type is anonymous".  I found that even if B_Type.A is declared as an anonymous access type, putting this in Direct_Assignment:

   B.A := Models.A.A_Access_Type' (new Models.A.A_Type);

eliminates the huge difference in execution time, because now the allocator is not returning an anonymous access type.

> 2. Avoid anonymous access types. Prefer named access types and 'Unchecked_Access.

I hope we don't have to draw this conclusion.  It would be sad if, with our right hand, we're urging people to adopt Ada because of its safety, and then with our left hand we recommend that they use 'Unchecked_Access and defeat the safety mechanism.

                                  -- Adam

Re: Anonymous access types are evil, why?

[Randy Brukardt]

"Adam Beneschan" <adambeneschan@aol.com> wrote in message 
news:66f24ada-122c-4c01-9f04-5bc92233a456@googlegroups.com...
...
>> 2. Avoid anonymous access types. Prefer named access types and 
>> 'Unchecked_Access.
>
>I hope we don't have to draw this conclusion.  It would be sad if, with our 
>right hand,
>we're urging people to adopt Ada because of its safety, and then with our 
>left hand
>we recommend that they use 'Unchecked_Access and defeat the safety 
>mechanism.

Not sure why preferring named access types would imply anything about 
'Access or 'Unchecked_Access. If you're using either of those, you almost 
never have a choice - you almost always have to use 'Unchecked_Access. But 
you shouldn't have to use either, as Ada allows explicit conversion of 
structurally similar access types. You need named types in order to use 
structural conversion, of course.

Certainly "avoid anonymous access types" is good advice, not the least of 
which that they usually imply run-time accessibility checking overhead, 
which is never needed for named access types.

                          Randy.

Re: Anonymous access types are evil, why?

[ake.ragnar.dahlgren]

On Wednesday, August 28, 2013 6:10:15 PM UTC+2, Adam Beneschan wrote:
> On Wednesday, August 28, 2013 4:49:56 AM UTC-7, ake.ragna...@gmail.com wrote: > 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: [rest snipped] I get the same results with GNAT 2012, but not GNAT 2011. Also, there were some rule changes in Ada 2012 with respect to allocators whose type is an anonymous access type, which is what you're dealing with when you assign B.A in Direct_Assignment. A cursory reading of 3.10.2(14/3) makes me think that none of the rule changes should apply in this case, but I don't know. (Yes, I'm aware that "cursory reading" and "3.10.2" should never appear together in the same sentence.) So I'd guess that the overhead is due to the way GNAT changed its implementation to deal with the new rules. Whether it did so correctly or not, I can't say. I'm not familiar enough with the ramifications of the new rules to have any idea what kind of implementation overhead they may require, and I'm not a GNAT developer in any case. > 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). More the the point, this probably means "an allocator whose type is a named access type should be preferred over an allocator whose type is anonymous". I found that even if B_Type.A is declared as an anonymous access type, putting this in Direct_Assignment: B.A := Models.A.A_Access_Type' (new Models.A.A_Type); eliminates the huge difference in execution time, because now the allocator is not returning an anonymous access type. > 2. Avoid anonymous access types. Prefer named access types and 'Unchecked_Access. I hope we don't have to draw this conclusion. It would be sad if, with our right hand, we're urging people to adopt Ada because of its safety, and then with our left hand we recommend that they use 'Unchecked_Access and defeat the safety mechanism. -- Adam

Thanks for your analysis and especially the interesting result "an allocator whose type is a named access type should be preferred over an allocator whose type is anonymous".

Best regards,
Åke Ragnar Dahlgren

Re: Anonymous access types are evil, why?

[Adam Beneschan]

On Friday, August 30, 2013 12:29:17 AM UTC-7, ake.ragna...@gmail.com wrote:

> Thanks for your analysis and especially the interesting result "an allocator whose type is a named access type should be preferred over an allocator whose type is anonymous".

You're welcome, but I didn't mean for this to be taken as a general rule of Ada programming.  It looks like it's a helpful rule for this particular implementation (GNAT 2013), but I still don't know whether the implementation is correct or whether the extra overhead you're seeing is actually necessary.  It could be that this is a problem with GNAT, and they'll fix it, and that in the future there may not be a reason to prefer allocators whose types are named.  I just don't know.

                               -- Adam

Re: Anonymous access types are evil, why?

[Robert A Duff]

Adam Beneschan <adambeneschan@aol.com> writes:

> On Friday, August 30, 2013 12:29:17 AM UTC-7, ake.ragna...@gmail.com wrote:
>
>> Thanks for your analysis and especially the interesting result "an
>> allocator whose type is a named access type should be preferred over
>> an allocator whose type is anonymous".
>
> You're welcome, but I didn't mean for this to be taken as a general
> rule of Ada programming.  It looks like it's a helpful rule for this
> particular implementation (GNAT 2013), but I still don't know whether
> the implementation is correct or whether the extra overhead you're
> seeing is actually necessary.  It could be that this is a problem with
> GNAT, and they'll fix it, and that in the future there may not be a
> reason to prefer allocators whose types are named.  I just don't know.

I didn't look at the example -- I don't know if there's a GNAT bug or
not.  But I think "prefer named access types" is pretty good general
advice.  Anonymous access types have their uses, but they're pretty
special purpose.

"access T" is not just an innocuous shorthand for avoiding having to
name the access type.  Too bad.  Access types are one of the few places
where you usually want "by structure" type equivalence rather than "by
name".

- Bob

Re: Anonymous access types are evil, why?

[sbelmont700]

On Wednesday, August 28, 2013 7:49:56 AM UTC-4, ake.ragna...@gmail.com wrote:
> 
> What are the conclusions we can draw?
> 

If you are going to use an AAT, always make sure you have a valid reason for doing it and understand the ramifications.  They are a specific tool for providing specific behavior in specific circumstances, not just a general syntax shortcut to avoid having to properly declare your types.

-sb

Re: Anonymous access types are evil, why?

[Shark8]

On Wednesday, August 28, 2013 2:16:19 PM UTC-6, sbelm...@gmail.com wrote:
> 
> If you are going to use an AAT, always make sure you have a valid reason for doing it and understand the ramifications.  They are a specific tool for providing specific behavior in specific circumstances, not just a general syntax shortcut to avoid having to properly declare your types.

In the FORTH  implementation I was building I had to use AAT because the compiler crashed out when I tried using the type directly [limited with], but for some reason allows AAT.

Re: Anonymous access types are evil, why?

[Gerhard Rummel]

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;