Controlled types (temporary anonymous objects), Ada

Controlled types (temporary anonymous objects)

with Ada.Text_IO; 
with ada.finalization;
with ada.unchecked_deallocation;
with system.address_image;

procedure Hello is

package bank is 
    type integer_acc is access integer;
    procedure free is new ada.unchecked_deallocation(integer, integer_acc);
    type account is new ada.finalization.controlled with record
        id : integer_acc;
        cnt : integer := -1;
    end record;
    
    function make(id : integer) return account;
    procedure Initialize(self : in out account);
    procedure Adjust(self : in out account);
    procedure Finalize(self : in out account);
end bank;

package body bank is
    function make(id : integer) return account is
    begin
        return self : account do
            self.id := new Integer'(id);
        end return;
    end make;
    
    procedure Initialize(self : in out account) is
    begin     
        ada.text_io.put_line("Initializing"&self.cnt'img&' '&system.address_image(self'address));
    end initialize;
    
    procedure Adjust(self : in out account) is
    begin
        ada.text_io.put(self.cnt'img);
        self.cnt := self.cnt + 1;
        ada.text_io.put_line(" Adjusting "&self.cnt'img&' '&system.address_image(self'address));
    end Adjust;
    
    procedure Finalize(self : in out account) is
    begin
        ada.text_io.put(self.cnt'img);
        self.cnt := self.cnt - 1;
        ada.text_io.put_line(" Finalizing "&self.cnt'img&' '&system.address_image(self'address));
        if self.cnt = 0 then
        ada.text_io.put_line("Freeing");
            free(self.id);
         end if;
    end finalize;
end bank;

x : bank.account := bank.make(100);
begin
    ada.text_io.put_line(x.id.all'img);
end Hello;


run \| edit \| history \| help	1

λ

                                      .NET NoSQL database for rapid development