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.5 required=5.0 tests=BAYES_00,INVALID_MSGID,
	PP_MIME_FAKE_ASCII_TEXT autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII
X-Google-Thread: 103376,4f4ee91990d68693
X-Google-Attributes: gid103376,public
From: "Joachim Schroeer" <schroeer@amst.co.at>
Subject: Re: Usefulness of classwide "out" parameter
Date: 1999/03/15
Message-ID: <7ciur9$p89$1@fleetstreet.Austria.EU.net>#1/1
X-Deja-AN: 455193466
References: <7cikku$d4k$1@nnrp1.dejanews.com>
X-MimeOLE: Produced By Microsoft MimeOLE V4.72.3110.3
X-Complaints-To: abuse@Austria.EU.net
X-Trace: fleetstreet.Austria.EU.net 921501353 25865 193.154.148.233 (15 Mar
 1999 12:35:53 GMT)
Organization: AMST
NNTP-Posting-Date: 15 Mar 1999 12:35:53 GMT
Newsgroups: comp.lang.ada
Date: 1999-03-15T12:35:53+00:00
List-Id: <comp.lang.ada>


okellogg@my-dejanews.com schrieb in Nachricht
<7cikku$d4k$1@nnrp1.dejanews.com>...

Your logic may be implemented by a function (func below) returning a
classwide type or by using a classwide access type for the out
parameter of procedure proc. Then the 2 objects in base.adb have to
be aliased.
The attached modified code compiles with ObjectAda and GNAT.

    J. Schr�er


-- base.ads
package Base is
   type Mytype is tagged null record;
   function Func return Mytype'Class;

   type Mytype_Access is access all Mytype'Class;
   procedure Proc (Result : out Mytype_Access);
end Base;

-- base-derived1.ads
package Base.Derived1 is
   type Deriv1 is new Mytype with null record;
end Base.Derived1;

-- base-derived2.ads
package Base.Derived2 is
   type Deriv2 is new Mytype with null record;
end Base.Derived2;

-- base.adb
with Base.Derived1, Base.Derived2;
package body Base is
   V1 : aliased Base.Derived1.Deriv1;
   V2 : aliased Base.Derived2.Deriv2;
   Some_Flag : Boolean := False;
   function Func return Mytype'Class is
   begin
      if Some_Flag then
         return V1;
      else
         return V2;
      end if;
   end Func;
  procedure Proc (Result : out Mytype_Access) is
  begin
      if Some_Flag then
         Result := V1'access;
      else
         Result := V2'access;
      end if;
   end Proc;
end Base;