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=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,3fc1c2283df835d5
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-07-30 08:52:31 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!news-spur1.maxwell.syr.edu!news.maxwell.syr.edu!newsfeed.icl.net!newsfeed.fjserv.net!news-FFM2.ecrc.net!news.iks-jena.de!not-for-mail
From: Lutz Donnerhacke <lutz@iks-jena.de>
Newsgroups: comp.lang.ada
Subject: Re: Limited_Controlled types as 'out' arguments
Date: Wed, 30 Jul 2003 15:52:30 +0000 (UTC)
Organization: IKS GmbH Jena
Message-ID: <slrnbifqdp.o6.lutz@taranis.iks-jena.de>
References: <slrnbifb3k.o6.lutz@taranis.iks-jena.de>
 <stcfivs5gk0u0gvhefqohlmhjheg1gshl0@4ax.com>
 <slrnbifemd.o6.lutz@taranis.iks-jena.de>
 <f8kfivgf1c7hbe7o0ln983d1r1v0eq4cmu@4ax.com>
 <slrnbiflb5.o6.lutz@taranis.iks-jena.de>
NNTP-Posting-Host: taranis.iks-jena.de
X-Trace: branwen.iks-jena.de 1059580350 20386 217.17.192.37 (30 Jul 2003
 15:52:30 GMT)
X-Complaints-To: usenet@iks-jena.de
NNTP-Posting-Date: Wed, 30 Jul 2003 15:52:30 +0000 (UTC)
User-Agent: slrn/0.9.7.4 (Linux)
Xref: archiver1.google.com comp.lang.ada:41023
Date: 2003-07-30T15:52:30+00:00
List-Id: <comp.lang.ada>

* Lutz Donnerhacke wrote:
> * Dmitry A Kazakov wrote:
>> On Wed, 30 Jul 2003 12:32:17 +0000 (UTC), Lutz Donnerhacke
>>>In my implementation, the type Test contains an array_access, I have to
>>>deallocate, before assigning a new value. I can not deallocate this access
>>>variable, because the procedure Free (unchecked_deallocate) requires an
>>>'in out' Parameter. But I only have an 'out' paramter. So I can't read it,
>>>before the first write.
>>
>> You can in Ada 95.
> 
> Oops. Why? This is a clear data flow error, which should be avoided.

To stress this point even more. The approbriate counterpart using assignment
statments and controlled types result in:

------------------------------------------------------------------------
with Ada.Finalization;

package t1 is
   type Char_Access is access Character;
   type Test is new Ada.Finalization.Controlled with record
      a : Char_Access;
   end record;
   procedure Initialize(o : in out Test);
   procedure Finalize(o : in out Test);
   procedure Adjust(o : in out Test);
end t1;
------------------------------------------------------------------------
with t1;
use t1;

procedure t is
   a, b, c : Test;
begin
   a := b;
   a := c;
end t;
------------------------------------------------------------------------
with Ada.Text_IO;
with System.Storage_Elements, System.Address_To_Access_Conversions;
with Unchecked_Deallocation;
use Ada.Text_IO;

package body t1 is
   procedure Debug (msg : String; p : Char_Access) is
      use System.Storage_Elements;
      package Convert is new System.Address_To_Access_Conversions(Character);
   begin
      Put_Line(msg &
        Integer_Address'Image(To_Integer(
            Convert.To_Address(Convert.Object_Pointer(p)))) &
        '(' & p.all & ')');
   end Debug;
   
   global : Character := '0';
   
   procedure Initialize(o : in out Test) is
   begin
      o.a := new Character'(global);
      Debug("Initializing", o.a);
      global := Character'Succ(global);
   end Initialize;
   
   procedure Finalize(o : in out Test) is
      procedure Free is new Unchecked_Deallocation(Character, Char_Access);
   begin
      Debug("Finalizing", o.a);
      Free(o.a);
   end Finalize;
   
   procedure Adjust(o : in out Test) is
      procedure Free is new Unchecked_Deallocation(Character, Char_Access);
      tmp : Char_Access := new Character'(' '); -- occupy some memory
   begin
      Debug("Adjusting from", o.a);
      o.a := new Character'(o.a.all);
      Debug("Adjusting to  ", o.a);
      Free(tmp);
   end Adjust;
end t1;
------------------------------------------------------------------------

Results in:
  Initializing 134630032(0)
  Initializing 134630048(1)
  Initializing 134630064(2)
  Finalizing 134630032(0)
  Adjusting from 134630048(1)
  Adjusting to   134630080(1)
  Finalizing 134630080(1)
  Adjusting from 134630064(2)
  Adjusting to   134630032(2)
  Finalizing 134630064(2)
  Finalizing 134630048(1)
  Finalizing 134630032(2)

Despite the upthead argument "there are only three instances, so finalizing
them suffice", here are also only three instances, which are finalized before
assigment.

Trying it with an 'out' parameter
   procedure Set(o : out Test) is
   begin
      Debug("Setting from", o.a);
      o.a := new Character'(global);
      Debug("Setting to  ", o.a);
      global := Character'Succ(global);
   end Set;
[...]
with t1;
use t1;

procedure t is
   a, b, c : Test;
begin
   a := b;
   a := c;
   Set(a);
   Set(a);
end t;
------------------------------------------------------------------------

gives:
  Initializing 134630064(0)
  Initializing 134630080(1)
  Initializing 134630096(2)
  Finalizing 134630064(0)
  Adjusting from 134630080(1)
  Adjusting to   134630112(1)
  Finalizing 134630112(1)
  Adjusting from 134630096(2)
  Adjusting to   134630064(2)
  Setting from 134630064(2)
  Setting to   134630112(3)
  Setting from 134630112(3)
  Setting to   134630128(4)
  Finalizing 134630096(2)
  Finalizing 134630080(1)
  Finalizing 134630128(4)
  
which is clearly wrong in the same way.

So the only result of this can be: Do not provide 'out' Parameters to
controlled types in the same library unit.