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.2 required=5.0 tests=BAYES_00,INVALID_MSGID,
	REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,b550c25b7ecf7e27,start
X-Google-Attributes: gid103376,public
From: Tom Moran <tmoran@bix.com>
Subject: Adjust bug? re-post
Date: 1997/07/19
Message-ID: <33D11675.2FDB@bix.com>#1/1
X-Deja-AN: 257743163
Organization: InterNex Information Services 1-800-595-3333
Reply-To: tmoran@bix.com
Newsgroups: comp.lang.ada
Date: 1997-07-19T00:00:00+00:00
List-Id: <comp.lang.ada>


(It seems this post got lost - apologies if you got it twice.)
This test program assigns the 'controlled' result from a function
to a variable.  Two compilers create an intermediate anonymous object
and copy and adjust to it before copying and adjusting to the final
result.  The third compiler does only the final adjust.  Is this
legal according to 7.6(21)?  Making the component 'id' aliased does
not change the behavior.  The result is that the anonymous object
is eventually Finalized without ever having been Initialized or
Adjusted,
with sad results for my program.  Is this a bug in the third compiler,
or a legal (though unfortunate) possibility?

with ada.finalization;
package testc is
  type c_type is new ada.finalization.controlled with record
    id:integer:=0;
  end record;

  function create return c_type;
  procedure initialize(x:in out c_type);
  procedure adjust    (x:in out c_type);
  procedure finalize  (x:in out c_type);
end testc;

with ada.text_io;
with ada.unchecked_conversion;
package body testc is

  type a is access all c_type;

  function showa is new ada.unchecked_conversion(a,long_integer);

  function create return c_type is
    newborn:aliased c_type;
  begin
    ada.text_io.put_line("creating" & integer'image(newborn.id) &
long_integer'image(showa(newborn'unchecked_access)));
    newborn.id:=7;
    return newborn;
  end create;

  count:natural:=0;

  procedure initialize(x:in out c_type) is
  begin
    count:=count+1;x.id:=count;
    ada.text_io.put_line("init"
      & integer'image(x.id) &
long_integer'image(showa(x'unchecked_access)));
  end initialize;

  procedure adjust    (x:in out c_type) is
  begin
    ada.text_io.put_line("adj"
      & integer'image(x.id) &
long_integer'image(showa(x'unchecked_access)));
  end adjust;

  procedure finalize(x:in out c_type) is
  begin
    ada.text_io.put_line("fin"
      & integer'image(x.id) &
long_integer'image(showa(x'unchecked_access)));
  end finalize;

end testc;

with ada.text_io,testc;
procedure test is

   procedure try is
     my_c:testc.c_type;
   begin
     ada.text_io.put_line("set");
     my_c:=testc.create;
     ada.text_io.put_line("did it");
   end try;

begin
  ada.text_io.put_line("start");
  try;
  ada.text_io.put_line("done");
end test;

two compilers           questionable compiler

start                   start
init 1 39318880         init 1 5897228
set                     set
init 2 39318744         init 2 5897016
creating 2 39318744     creating 2 5897016
adj 7 73084948          fin 1 5897228
fin 7 39318744          adj 7 5897228
fin 1 39318880          fin 7 4587648
adj 7 39318880          did it
fin 7 73084948          fin 7 5897228
did it                  done
fin 7 39318880
done