From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4
X-Received: by 2002:ac8:4655:: with SMTP id f21mr35924434qto.43.1571090278053;
        Mon, 14 Oct 2019 14:57:58 -0700 (PDT)
X-Received: by 2002:a9d:6043:: with SMTP id v3mr19227412otj.276.1571090277628;
 Mon, 14 Oct 2019 14:57:57 -0700 (PDT)
Path: 
 eternal-september.org!reader01.eternal-september.org!feeder.eternal-september.org!news.gegeweb.eu!gegeweb.org!usenet-fr.net!proxad.net!feeder1-2.proxad.net!209.85.160.216.MISMATCH!o24no8232951qtl.0!news-out.google.com!q23ni793qtl.1!nntp.google.com!o24no8232938qtl.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
Newsgroups: comp.lang.ada
Date: Mon, 14 Oct 2019 14:57:57 -0700 (PDT)
In-Reply-To: <5da4d8dc$0$20339$426a74cc@news.free.fr>
Complaints-To: groups-abuse@google.com
Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=146.5.2.231;
 posting-account=lJ3JNwoAAAAQfH3VV9vttJLkThaxtTfC
NNTP-Posting-Host: 146.5.2.231
References: <5da4cf81$0$20312$426a74cc@news.free.fr>
 <5da4d8dc$0$20339$426a74cc@news.free.fr>
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <4cbdb7ee-96aa-4653-8bae-65aea700e8f5@googlegroups.com>
Subject: Re: How to transfer Class-Wide object to a Task ?
From: Shark8 <onewingedshark@gmail.com>
Injection-Date: Mon, 14 Oct 2019 21:57:58 +0000
Content-Type: text/plain; charset="UTF-8"
Xref: reader01.eternal-september.org comp.lang.ada:57285
Date: 2019-10-14T14:57:57-07:00
List-Id: <comp.lang.ada>

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;