Usefulness of classwide "out" parameter

Usefulness of classwide "out" parameter

[okellogg]

Hi,

Has anyone ever used a classwide subprogram parameter with
mode "out" ?
For example,

    type Mytype is tagged null record;
    procedure Proc (Result : out Mytype'Class);

The problem I have with this is, I cannot assign another variable
to the out parameter (that would change the tag, which is not
possible.)

Am I correct in asserting that classwide parameters of mode "out"
are not terribly useful? What would a practical application of this
look like?

I am appending an example that shows the problem.

Thanks,

O. Kellogg
e-mail: oliver.kellogg@vs.dasa.de

-- base.ads
package Base is
   type Mytype is tagged null record;
   procedure Proc (Result : out Mytype'Class);
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 : Base.Derived1.Deriv1;
   V2 : Base.Derived2.Deriv2;
   Some_Flag : Boolean := False;
   procedure Proc (Result : out Mytype'Class) is
   begin
      if Some_Flag then
         Result := V1;   -- GNAT says:
      else
         Result := V2;   -- dynamically tagged expression required
      end if;
   end Proc;
end Base;

-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own    

Re: Usefulness of classwide "out" parameter

[Matthew Heaney]

okellogg@my-dejanews.com writes:

> Has anyone ever used a classwide subprogram parameter with mode "out"?

No, because it's not very useful.

> For example,
> 
>     type Mytype is tagged null record;
>     procedure Proc (Result : out Mytype'Class);
> 
> The problem I have with this is, I cannot assign another variable
> to the out parameter (that would change the tag, which is not
> possible.)

The only thing you could do assign the object, if the tag happened to
match.  Otherwise, you'll just get tag check errors.

> Am I correct in asserting that classwide parameters of mode "out" are
> not terribly useful?

That is indeed the case.


> What would a practical application of this look like?

Can you return a class-wide type as a function return instead?
Something like:

  function Func return MyType'Class;

 
> I am appending an example that shows the problem.

> -- base.ads
> package Base is
>    type Mytype is tagged null record;
>    procedure Proc (Result : out Mytype'Class);
> end Base;

This type is non-limited, so returning a class-wide type as the result
of a function would be OK.

 
> with Base.Derived1, Base.Derived2;
> package body Base is
>    V1 : Base.Derived1.Deriv1;
>    V2 : Base.Derived2.Deriv2;
>    Some_Flag : Boolean := False;
>    procedure Proc (Result : out Mytype'Class) is
>    begin
>       if Some_Flag then
>          Result := V1;   -- GNAT says:
>       else
>          Result := V2;   -- dynamically tagged expression required
>       end if;
>    end Proc;
> end Base;


How about this:

  function Func return Mytype'Class is
  begin
    if Some_Flag then
       return V1;
    else
       return V2;
    end if;
  end Func;

This should be fine for what you're trying to do.  But...

...what you're doing looks suspiciously like the singleton pattern.  If
you're returning the value of a statically allocated instance, then you
can just as easily return a pointer to it:

 type Mytype_Access is access constant Mytype'Class;

 package body P is

   V1 : aliased D1;
   V2 : aliased D2;
   
   procedure Proc (Result : out Mytype_Access) is
   begin
     if Some_Flag then
       Result := V1'Access;
     else
       Result := V2'Access;
   end Proc;

or

  function Func return Mytype_Access is
  begin
    if Some_Flag then
       return V1'Access;
    else
       return V2'Access;
    end if;
  end Func;

       
If you want to enforce cardinality, or just control how instances are
created, then you can declare the type as limited and indefinite.

Singletons are implemented by returning a pointer to the statically
declared instance in the body, and declaring primitive operations of the
type to take access parameters.

See my most recent post, "State Pattern," in the Mar 99 ACM patterns
archive, for an example of how to do this.  The article "Abstract
Factory Revisited" has lots of info about these idioms too.

<http://www.acm.org/archives/patterns.html>

You can subscribe to the patterns list by sending a message with the
body 

subscribe patterns <your full name>

to the ACM mailing list server.

<mailto:listserv@acm.org>

Re: Usefulness of classwide "out" parameter

[Joachim Schroeer]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1341 bytes --]


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;

Re: Usefulness of classwide "out" parameter

[Nick Roberts]

I think 'out' parameters of a classwide type will be useful in some
situations.  I am particularly thinking of a 'wrapper' procedure which
redispatches on the classwide parameter.  For example, consider an abstract
tagged type T, and suppose that it has an abstract procedure:

   procedure Create (Obj: out T) is abstract;

so that all types derived from T must have a 'Create' procedure, which
presumably initialises an object of that type in the appropriate way.

Now, supposing you wanted to monitor the creation of all objects of types
derived from T (perhaps writing a message onto a log file for each
occurrence).  You could do this by declaring a 'wrapper' procedure:

   procedure Monitored_Create (Obj: out T'Class) is
   begin
      Put_Line(Log_File,"Creating object of type " &
Ada.Tags.Expanded_Name(Obj'Tag));
      Create(Obj);
   end;

This procedure outputs a message onto a log file (using the known tag of the
object actually passed), and then redispatches on that object to the
requisite 'Create' procedure.

It may be that 'out' parameters of a classwide type are not likely to be
used very often, but, like many aspects of the language, I suspect they will
be useful every now and then!  (A bit like me, really ;-)

-------------------------------------
Nick Roberts
-------------------------------------