Re: Extending a third party tagged type while adding finalization

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

On Monday, November 27, 2017 at 10:00:11 AM UTC-5, AdaMagica wrote:
> Am Montag, 27. November 2017 13:56:36 UTC+1 schrieb Jere:
> > The intent was to be able to provide "overridable" Initialize
> > and Finalize to descendants of the mixin which would be called
> > automatically, but now I don't think that is possible in a safe way.
> 
> Why do you say this? In my paper, Final is a further derivation, and also derivations from Final will work as expected.

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:

**************************************************************
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Finalization;
with Ada.Task_Attributes;

procedure Main is
   generic

      type Uncontrolled (<>) is abstract tagged private;

      with procedure Adjust     (Object: in out Uncontrolled);
      with procedure Finalize   (Object: in out Uncontrolled);

   package To_Controlled is

      type Controlled is new Uncontrolled with private;

   private

      type Controlled_Ptr is access all Controlled;

      type Component is new Ada.Finalization.Controlled with record
         Parent: Controlled_Ptr;
      end record;

      type Controlled is new Uncontrolled with record
         Controller: Component := (Ada.Finalization.Controlled with
                                   Controlled'Unrestricted_Access);  -- Gnat only
      end record;

      procedure Adjust     (Object: in out Component);
      procedure Finalize   (Object: in out Component);

   end To_Controlled;
   
   package body To_Controlled is

      package Store is
         new Ada.Task_Attributes (Attribute     => Controlled_Ptr,
                                  Initial_Value => null);

      procedure Adjust (Object: in out Component) is
      begin
         Object.Parent := Store.Value;
         Adjust (Uncontrolled (Object.Parent.all));
      end Adjust;

      procedure Finalize (Object: in out Component) is
      begin
         Store.Set_Value (Object.Parent);
         Finalize (Uncontrolled (Object.Parent.all));
      end Finalize;

   end To_Controlled;
   
   package Components is
      type C1 is new Ada.Finalization.Controlled with null record;
      overriding procedure Adjust    (Self : in out C1);
      overriding procedure Finalize  (Self : in out C1);
      
      type C2 is new Ada.Finalization.Controlled with null record;
      overriding procedure Adjust    (Self : in out C2);
      overriding procedure Finalize  (Self : in out C2);
   end Components;
   
   package body Components is
      overriding procedure Adjust    (Self : in out C1) is
      begin
         Put_Line("Adjust C1");
      end Adjust;
      overriding procedure Finalize  (Self : in out C1) is
      begin
         Put_Line("Finalize C1");
      end Finalize;
      
      overriding procedure Adjust    (Self : in out C2) is
      begin
         Put_Line("Adjust C2");
      end Adjust;
      overriding procedure Finalize  (Self : in out C2) is
      begin
         Put_Line("Finalize C2");
      end Finalize;
   end Components;
   
   package Types is
      type Base is tagged record
         c1 : Components.C1;
      end record;
      
      type Derived is new Base with null record;
      procedure Adjust    (Self : in out Derived);
      procedure Finalize  (Self : in out Derived);
      
      package To_C is new To_Controlled
         (Derived, Adjust, Finalize);
      
      type Final is new To_C.Controlled with record
         c2 : Components.C2;
      end record;
      overriding procedure Adjust    (Self : in out Final);
      overriding procedure Finalize  (Self : in out Final);
      
   end Types;
      
   package body Types is
      procedure Adjust    (Self : in out Derived) is
      begin
         Put_Line("Adjust Derived");
      end Adjust;
      procedure Finalize  (Self : in out Derived) is
      begin
         Put_Line("Finalize Derived");
      end Finalize;
      
      procedure Adjust    (Self : in out Final) is
      begin
         Put_Line("Adjust Final");
      end Adjust;
      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;

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

with this the output is:
Starting
Finalize C2
Finalize Derived
Finalize C1

There is no "Finalize Final" as expected from inheritance

Did I put something in wrong?