Создание контролируемого типа вызовет финализацию по возвращении

Question

Я хочу создать функцию для создания и инициализации управляемого типа (немного похоже на фабрику) следующим образом:

function Create return Controlled_Type
is
  Foo : Controlled_Type;
begin
   Put_Line ("Check 1")
   return Foo;
end Create;

procedure Main
is
  Bar : Controlled_Type := Create;
begin
  Put_Line ("Check 2")
end Main;

output:
Initialize
Check 1
Adjust
Finalize

Так как finalize удалит некоторые объекты, на которые указывает управляемый тип, я получаю висячие указатели в Bar, и каким-то образом это сразу приводит к сбою программы, поэтому я никогда не вижу "Проверка 2".

Это можно легко решить, используя новый Controlled_Type и возвращая указатель в функции Create. Однако мне нравится идея иметь управляемый тип, а не указатель на него, так как финализация будет автоматически вызываться, когда Bar выходит из области видимости. Если бы Bar был указателем, мне пришлось бы вручную его утилизировать.

Есть ли способ сделать это правильно, не заканчивая висячими указателями? Должен ли я сделать немного магии в процедуре настройки?

Answer 1

Ну, вы должны реализовать Adjust соответственно!

Когда вы делаете копию, она побитовая, поэтому любой указатель в оригинале копируется как есть на копию. Когда оригинал будет завершен, а указанный объект освобожден, в копии останется указатель на гиперпространство.

Нужно выделить новый указатель, обозначающий то же значение, что и оригинал. Что-то вроде

with Ada.Finalization;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;

procedure Finalart is

   type Integer_P is access Integer;
   type Controlled_Type is new Ada.Finalization.Controlled with record
      P : Integer_P;
   end record;
   procedure Initialize (This : in out Controlled_Type);
   procedure Adjust (This : in out Controlled_Type);
   procedure Finalize (This : in out Controlled_Type);

   procedure Initialize (This : in out Controlled_Type) is
   begin
      Put_Line ("initialize");
      This.P := new Integer'(42);
   end Initialize;

   procedure Adjust (This : in out Controlled_Type) is
      Original_Value : constant Integer := This.P.all;
   begin
      Put_Line ("adjust");
      This.P := new Integer'(Original_Value);
   end Adjust;

   procedure Finalize (This : in out Controlled_Type) is
      procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_P);
   begin
      Put_Line ("finalize");
      Free (This.P);
   end Finalize;

   function Create return Controlled_Type is
      CT : Controlled_Type;
   begin
      Put_Line ("check 1");
      return CT;
   end Create;

   Bar : Controlled_Type := Create;
begin
   Put_Line ("check 2");
end Finalart;

Если я закомментирую строку This.P := new Integer'(Original_Value); в AdjustЯ получаю (на macOS)

$ ./finalart 
initialize
check 1
adjust
finalize
adjust
finalize
finalart(35828,0x7fffd0f8b3c0) malloc: *** error for object 0x7fca61500000: pointer being freed was not allocated
*** set a breakpoint in malloc_error_break to debug

raised PROGRAM_ERROR : unhandled signal