Re: How to transfer Class-Wide object to a Task ?

[Shark8 <onewingedshark@gmail.com>]

On Monday, October 14, 2019 at 2:21:50 PM UTC-6, William FRANCK wrote:
> On 2019-10-14 19:41:53 +0000, William FRANCK said:
> 
Maybe something like this:

    procedure Example is
        Package Types is
            Subtype Params is Ada.Streams.Root_Stream_Type'Class;
            Type Root   is abstract tagged null record;
            Function Create (Parameters : not null access Params) return Root is abstract;
            
            Type Circle is new Root with record
                Radius : Float;
            end record;
            
            Type Square is new Root with record
                Side : Integer;
            end record;
        Private
            
            Function Create (Parameters : not null access Params) return Square;
            Function Create (Parameters : not null access Params) return Circle;
        End Types;
        
        
        Use Types;
        Package Class_Holder is new Ada.Containers.Indefinite_Holders(Root'Class);
        Task Type Producer( Stream : not null access Ada.Streams.Root_Stream_Type'Class ) is
            Entry Get( Object: out Class_Holder.Holder );
        End Producer;
        
        Task body Producer is
            Function MAKE is new Ada.Tags.Generic_Dispatching_Constructor(
               T           => Types.Root,
               Parameters  => Ada.Streams.Root_Stream_Type'Class,
               Constructor => Types.Create
              );

            Function To_Tag return Ada.Tags.Tag is
            Begin
                Return Square'Tag;
--                  (if    Ch = 'C' then Circle'Tag
--                   elsif Ch = 'S' then Square'Tag
--                   else raise Constraint_Error with "Tag '"&Ch&"' is invalid.");
            End;
            
        Begin
            accept Get (Object : out Class_Holder.Holder) do
                Object:=
                  Class_Holder.To_Holder( MAKE(To_Tag, Stream) );
            end Get;
        end Producer;
        
        Function Get(P : Producer) return Root'Class is
            H : Class_Holder.Holder;
        Begin
            P.Get(H);
            Return H.Element;
        End Get;
        
        
        
        Package Body Types is
            Function Create(Parameters : not null access Params) return Square is
            Begin
                Return (Side => 3);
            End;
            
            Function Create(Parameters : not null access Params) return Circle is
            Begin
                Return (Radius => 2.2);
            End;
        End Types;
        
    begin
        Ada.Text_IO.Put_Line( "START EXAMPLE." );
        declare
            I : Ada.Text_IO.File_Type renames Ada.Text_IO.Standard_Input;
            P : Producer( Ada.Text_IO.Text_Streams.Stream(I) );
            O : Root'Class := Get(P);
        begin
            Ada.Text_IO.Put_Line( "Tag: " & Ada.Tags.Expanded_Name(O'Tag) );
        end;
        Ada.Text_IO.Put_Line( "STOP EXAMPLE." );
    end Example;