受控类型的创建将在 return 上调用完成

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 中得到了悬空指针，不知何故这立即使程序崩溃，所以我从来没有看到 "Check 2".

这可以通过使用 new Controlled_Type 并在 Create 函数中返回一个指针来轻松解决。但是，我喜欢拥有受控类型而不是指向它的指针的想法，因为当 Bar 超出范围时将自动调用终结。如果 Bar 是一个指针，我将不得不手动处理它。

有没有什么方法可以正确地做到这一点而不会以悬空指针结束？我应该在 Adjust 程序中做一些魔术吗？

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;

如果我在 Adjust 中注释掉行 This.P := new Integer'(Original_Value);，我会得到（在 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

受控类型的创建将在 return 上调用完成

Creation of controlled type will call finalize on return

factory

ada

dangling-pointer

finalization