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=unavailable autolearn_force=no version=3.4.4
Path: 
 eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!mx02.eternal-september.org!.POSTED!not-for-mail
From: "Alejandro R. Mosteo" <alejandro@mosteo.com>
Newsgroups: comp.lang.ada
Subject: Re: Finalization and class-wide views
Date: Thu, 16 Jun 2016 13:10:39 +0200
Organization: A noiseless patient Spider
Message-ID: <nju1fg$2ua$1@dont-email.me>
References: <njspjc$q21$1@dont-email.me>
Mime-Version: 1.0
Content-Type: text/plain; charset=utf-8; format=flowed
Content-Transfer-Encoding: 7bit
Injection-Date: Thu, 16 Jun 2016 11:10:40 -0000 (UTC)
Injection-Info: mx02.eternal-september.org;
 posting-host="df6c13c4617621ca1de5ec657b563bf1";
	logging-data="3018"; mail-complaints-to="abuse@eternal-september.org";
	posting-account="U2FsdGVkX1/1FZtMasRSrG5Eu4H7pnUZ"
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101
 Thunderbird/38.8.0
In-Reply-To: <njspjc$q21$1@dont-email.me>
X-Mozilla-News-Host: news://news.eternal-september.org
Cancel-Lock: sha1:Tb3TGpbOI+yUS9wGipSNvv+SWdg=
Xref: news.eternal-september.org comp.lang.ada:30759
Date: 2016-06-16T13:10:39+02:00
List-Id: <comp.lang.ada>

As a follow-up I've modified the example with actual memory 
allocation/deallocation, and valgrind seems to confirm the brokenness of 
the third assignment in the original example.

valgrind --leak-check=full output:

==21058== HEAP SUMMARY:
==21058==     in use at exit: 2,664 bytes in 666 blocks
==21058==   total heap usage: 2,670 allocs, 2,004 frees, 10,680 bytes 
allocated
==21058==
==21058== 2,664 bytes in 666 blocks are definitely lost in loss record 1 
of 1
==21058==    at 0x4C2DB8F: malloc (in 
/usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so)
==21058==    by 0x41623C: __gnat_malloc (in 
/home/jano/local/rxada/obj/finalize_leak)
==21058==    by 0x402B0A: finalize_leak__pp__adjust.3673 
(finalize_leak.adb:30)
==21058==    by 0x402B4D: finalize_leak__pp__twoDA.3946 
(finalize_leak.adb:32)
==21058==    by 0x404D96: _ada_finalize_leak (finalize_leak.adb:67)
==21058==    by 0x405887: main (b__finalize_leak.adb:241)
==21058==
==21058== LEAK SUMMARY:
==21058==    definitely lost: 2,664 bytes in 666 blocks
==21058==    indirectly lost: 0 bytes in 0 blocks
==21058==      possibly lost: 0 bytes in 0 blocks
==21058==    still reachable: 0 bytes in 0 blocks
==21058==         suppressed: 0 bytes in 0 blocks
==21058==
==21058== For counts of detected and suppressed errors, rerun with: -v
==21058== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0)

With this I feel confident enough to file a bug report. Here is the 
modified program. The type Managed now holds a heap-allocated integer.

with Ada.Finalization; use Ada.Finalization;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Unchecked_Deallocation;

procedure Finalize_Leak is
    generic
    package P is

       type One is interface;

       type Int_Access is access Integer;

       type Managed is new Controlled with record
          X : Int_Access;
       end record;
       overriding procedure Adjust (M : in out Managed);
       overriding procedure Finalize (M : in out Managed);
       function Build (I : Integer) return Managed;

       type Two is new One with record
          M : Managed := Build (1);
       end record;

    end P;

    package body P is
       overriding procedure Adjust (M : in out Managed) is
       begin
          if M.X /= null then
             M.X := new Integer'(M.X.all);
          end if;
       end Adjust;

       overriding procedure Finalize (M : in out Managed) is
          procedure Free is
            new Ada.Unchecked_Deallocation (Integer, Int_Access);
       begin
          if M.X /= null then
             Free (M.X);
             Put_Line ("finalize M with free");
          else
             Put_Line ("finalize M");
          end if;
       end Finalize;

       function Build (I : Integer) return Managed
       is (Managed'(Controlled with X => new Integer'(I)));
    end P;

    package PP is new P; use PP;

    function Pass (X : Two'Class) return One'Class is (X);
    function "not" (X : Two'Class) return One'Class is (X);

    A : Two;
begin
    A.M := Build (1);

    for I in 1 .. 666 loop
       Put_Line ("----------------------------");
       declare
          B : One'Class := Pass (A); -- This is properly finalized
       begin
          Put_Line ("......");
       end;
       Put_Line ("......");

       declare
          B : One'Class := not A; -- This is not
       begin
          Put_Line ("---8<---");
       end;
       Put_Line ("--->8---");
    end loop;

    New_Line; Put_Line ("Now A is going to finalize");
end Finalize_Leak;