Re: Extending a third party tagged type while adding finalization

[Jere <jhb.chat@gmail.com>]

On Monday, November 27, 2017 at 1:37:22 PM UTC-5, AdaMagica wrote:
> Am Montag, 27. November 2017 17:38:02 UTC+1 schrieb Jere:
> > On Monday, November 27, 2017 at 10:00:11 AM UTC-5, AdaMagica wrote:
> > well, when I tried your example it didn't call the finalization routing for
> > any derived types.  I might have mis-copied it somehow.  Here is a 
> > compilable example:
> > procedure Main is
> >    generic
> > 
> >       type Uncontrolled (<>) is abstract tagged private;
> > 
> >       with procedure Adjust     (Object: in out Uncontrolled);
> >       with procedure Finalize   (Object: in out Uncontrolled);
> 
> The problem is in your generic parameter part. See section 3 of my paper and download the full code (see the end of the paper).
> 
> It's really a problem that opens the gates of hell as I've written as an intro.
> It can definitly only work for limited types.

Sorry about that.  I copied it from your paper (and changed some names) 
but I think I copied from the wrong place.  I downloaded code, added 
controlled components to both Parent and Final.  I saw the same results
(out of order initialization and finalization).  I don't know how you
feel about reposting your copyrighted code so here is a handmade main
linking to your code to show what I mean:

******************************************
with Ada.Text_IO; use Ada.Text_IO;
with Add_Finalization.To_Limited_Uncontrolled;
with Ada.Finalization;

procedure Main is
   
   -- Just some controlled components to add later
   package Components is
      type C1 is new Ada.Finalization.Limited_Controlled with null record;
      overriding procedure Initialize(Self : in out C1);
      overriding procedure Finalize  (Self : in out C1);

      type C2 is new Ada.Finalization.Limited_Controlled with null record;
      overriding procedure Initialize(Self : in out C2);
      overriding procedure Finalize  (Self : in out C2);
   end Components;

   package body Components is
      overriding procedure Initialize(Self : in out C1) is
      begin
         Put_Line("Initialize C1");
      end Initialize;
      overriding procedure Finalize  (Self : in out C1) is
      begin
         Put_Line("Finalize C1");
      end Finalize;

      overriding procedure Initialize(Self : in out C2) is
      begin
         Put_Line("Initialize C2");
      end Initialize;
      overriding procedure Finalize  (Self : in out C2) is
      begin
         Put_Line("Finalize C2");
      end Finalize;
   end Components;

   package Types is
      type Base is tagged limited record
         c1 : Components.C1;
      end record;

      type Derived is new Base with null record;
      procedure Initialize(Self : in out Derived);
      procedure Finalize  (Self : in out Derived);
      
      procedure Initialize_Redipatch(Self : in out Derived'Class);
      procedure Finalize_Redipatch(Self : in out Derived'Class);

      package To_LC is new Add_Finalization.To_Limited_Uncontrolled
         (Derived, Initialize_Redipatch, Finalize_Redipatch);

      type Final is new To_LC.Controlled with record
         c2 : Components.C2;
      end record;
      overriding procedure Initialize(Self : in out Final);
      overriding procedure Finalize  (Self : in out Final);

   end Types;

   package body Types is
      
      procedure Initialize_Redipatch(Self : in out Derived'Class) is
      begin
         Self.Initialize;
      end Initialize_Redipatch;
      procedure Finalize_Redipatch(Self : in out Derived'Class) is
      begin
         Self.Finalize;
      end Finalize_Redipatch;
      
      procedure Initialize(Self : in out Derived) is
      begin
         Put_Line("Initialize Derived");
      end Initialize;
      procedure Finalize  (Self : in out Derived) is
      begin
         Put_Line("Finalize Derived");
      end Finalize;

      procedure Initialize(Self : in out Final) is
      begin
         Put_Line("Initialize Final");
      end Initialize;
      procedure Finalize  (Self : in out Final) is
      begin
         Put_Line("Finalize Final");
      end Finalize;
   end Types;

   v : Types.Final;
begin
   Put_Line ("Starting");

end Main;

******************************************

The output for this is:
Initialize C1
Initialize Final
Initialize C2
Starting
Finalize C2
Finalize Final
Finalize C1

which is the same thing I was seeing with my version.  Final is initialized
before C2 and C2 is finalized before Final.  

I can repost the modified version of your code if this isn't sufficient to
show the issue.  I just wasn't sure if I should.  The output from the
modified copy of your code:

Initialize C1
Final: I am being initialized 4
Derived: I am being initialized 2147483647
Initialize C2
Global
Final: I am 100
Derived: I am 2147483647
Parent: I am-2147483648
Initialize C1
Final: I am being initialized 4
Derived: I am being initialized 2147483647
Initialize C2
Local
Final: I am 52
Derived: I am 51
Parent: I am 50
Local out of scope
Finalize C2
Final: I am being finalized.
Final: I am 52
Derived: I am 51
Parent: I am 50
Derived: I am being finalized 51
Derived: I have been finalized 0
Final: I am 0
Derived: I am 0
Parent: I am 0
Final: I have been finalized.
Finalize C1
Global
Final: I am 100
Derived: I am 2147483647
Parent: I am-2147483648
Global out of scope
Finalize C2
Final: I am being finalized.
Final: I am 100
Derived: I am 2147483647
Parent: I am-2147483648
Derived: I am being finalized 2147483647
Derived: I have been finalized 0
Final: I am 0
Derived: I am 0
Parent: I am 0
Final: I have been finalized.
Finalize C1