delphi - 具有接口(interface)的递归函数的访问冲突

Question

我正在努力解决这个问题。这很奇怪，因为它不会引发堆栈溢出错误，而是会引发访问冲突错误。 (见下面的代码。)

每当调用 CallDestructor 函数时，都会调用 DestroyChildren。所以这是一个递归函数。

当我只处理几个对象时，它工作正常。我的麻烦是当我有很多实例要销毁时。

unit AggregationObject;

interface

uses
  System.Classes, System.Generics.Collections, System.Contnrs;

type
  IParentObject = Interface;

  IChildObject = Interface
    ['{061A8518-0B3A-4A1C-AA3A-4F42B81FB4B5}']
    procedure CallDestructor();
    procedure ChangeParent(Parent: IParentObject);
  End;

  IParentObject = Interface
    ['{86162E3B-6A82-4198-AD5B-77C4623481CB}']
    procedure AddChild(ChildObject: IChildObject);
    function  RemoveChild(ChildObject: IChildObject): Integer;
    function  ChildrenCount(): Integer;
    procedure DestroyChildren();
  End;

  TName = type String;
  TChildObject = class(TInterfacedPersistent, IChildObject)
    protected
      FParentObject: IParentObject;
    public
      constructor Create( AParent: IParentObject ); virtual;

      {IChildObject}
      procedure CallDestructor();
      procedure ChangeParent(Parent: IParentObject);
  end;

  TParentObject = class(TInterfacedPersistent, IParentObject)
    strict private
      FChildren: TInterfaceList;
    private
      FName: TName;
    public
      constructor Create();

      {Polimórficos}
      procedure BeforeDestruction; override;

      {IParentObject}
      procedure AddChild(AChildObject: IChildObject);
      function  RemoveChild(AChildObject: IChildObject): Integer;
      function  ChildrenCount(): Integer;
      procedure DestroyChildren();

      property Name: TName read FName write FName;
  end;

  TAggregationObject = class(TChildObject, IParentObject)
    private
      FController: IParentObject;
      function GetController: IParentObject;
    public
      constructor Create( AParent: IParentObject ); override;
      destructor Destroy(); override;

    {Controller implementation}
    public
      property Controller: IParentObject read GetController implements IParentObject;
  end;

implementation

uses
  System.SysUtils, Exceptions;

{ TChildObject }

procedure TChildObject.CallDestructor;
begin
  Self.Free;
end;

procedure TChildObject.ChangeParent(Parent: IParentObject);
begin
  if Self.FParentObject <> nil then
    IParentObject( Self.FParentObject ).RemoveChild( Self );

  Self.FParentObject := Parent;
  if Parent <> nil then
    Parent.AddChild( Self );
end;

constructor TChildObject.Create(AParent: IParentObject);
begin
  if not (AParent = nil) then
  begin
    FParentObject := AParent;
    FParentObject.AddChild( Self );
  end;
end;

{ TParentObject }

procedure TParentObject.AddChild(AChildObject: IChildObject);
begin
  if (FChildren = nil) then FChildren := TInterfaceList.Create();
    FChildren.Add( AChildObject );
end;

procedure TParentObject.BeforeDestruction;
begin
  inherited;
  DestroyChildren();
end;

function TParentObject.ChildrenCount: Integer;
begin
  Result := -1;
  if Assigned(FChildren) then
    Result := FChildren.Count;
end;

constructor TParentObject.Create;
begin
  FName := 'NoName';
end;

procedure TParentObject.DestroyChildren;
var
  Instance: IChildObject;
begin
  while FChildren <> nil do
  begin
    Instance := FChildren.Last as IChildObject;
    if Instance <> nil then
    begin
      if RemoveChild( Instance ) > -1 then
      begin
        try
          Instance.CallDestructor();
        except on E: Exception do
          raise EChildAlReadyDestroyed.Create('Parent: ' + Self.FName + #13#10 + E.Message);
        end;
      end;
    end;
  end;
end;

function TParentObject.RemoveChild(AChildObject: IChildObject): Integer;
begin
  Result := -1;{if has no children}
  if (FChildren <> nil) then
  begin

    Result := 0;{ Index 0}
    if ( ( FChildren.Items[0] as IChildObject) = AChildObject) then
      FChildren.Delete(0)
    else
      Result := FChildren.RemoveItem( AChildObject, TList.TDirection.FromEnd );

    if (FChildren.Count = 0) then
    begin
      FreeAndNil( FChildren );
    end;
  end;
end;

{ TAggregationObject }

constructor TAggregationObject.Create(AParent: IParentObject);
begin
  inherited Create(AParent);
  FController := TParentObject.Create();
  ( FController as TParentObject ).Name := Self.ClassName + '_Parent';
end;

destructor TAggregationObject.Destroy;
begin
  ( FController as TParentObject ).Free;
  inherited;
end;

function TAggregationObject.GetController: IParentObject;
begin
  Result := FController;
end;

end.

Answer 1

OP 设法找出问题所在，但尚未发布答案。我提供了他评论的编辑版本并添加了更详细的解释。

I think the problem was with mixing object reference and interface. Even though my objects aren't controlled by RefCount something hapens backstage: "However, due to the nature of interface references, _AddRef and _Release are still going to be called when the reference goes out of scope. If the class has been destroyed prior to that time, then you have an AV in _IntfClear." My last call in stack is _IntfClear or _IntfCopy. I think this is the problem. I'm not sure about how to correct that, so I've changed to an abstract class.

访问冲突不是由混合对象引用和接口(interface)引起的；有一些方法可以安全地做到这一点。
但它们是由于 Delphi 试图 _Release 对已被销毁的对象的引用而引起的。

然而，这提出了一个问题:“为什么 AV 只是有时发生，而不是一直发生？”

为了解释，我将讨论一个非法内存操作。我的意思是一段代码(或对象)访问了它不应该访问的内存。

您不会在每次程序执行非法内存操作 时都获得 AV。仅当注意到非法内存操作时才会引发 AV!它可能被忽视的主要原因有两个:

• 程序中的一个对象访问某些内存可能是“非法的”，但如果另一个实例访问该内存是合法的 - 那么系统就没有办法注意到您确实进行了非法内存操作。
• 大多数时候，FastMem 从操作系统请求的内存比您实际从 FastMem 请求的“页面”更大。然后它会跟踪页面上的多个较小的分配。只有当页面上没有剩余更小的分配时，页面才会返回给操作系统。因此，操作系统不会注意到任何非法内存操作，该页面仍分配给您的程序。

上面的第二个原因是少量对象不会导致AV:分配对象的页面仍然分配给你的程序。
但是当你有大量的实例时:有时当你销毁一个对象时，它是页面上的最后一个；然后页面返回给操作系统...因此，当在该页面上调用 _Release 时，您将获得 AV。

那么，如何解决呢？

好吧，您选择的选项(使用抽象类而不是接口(interface))有效。但是你失去了接口(interface)的好处。但是，我建议不要尝试手动控制接口(interface)对象的销毁。接口(interface)引用的好处之一是底层对象会自毁(如果你允许的话)。

我怀疑您这样做是因为您混合了对象引用和接口(interface)引用。因此，与其强制您的接口(interface)表现得像对象(您为此遇到了很多麻烦)，不如简单地让每个对象引用手动添加对接口(interface)的引用。您可以使用以下代码执行此操作:

(ObjectRef as IUnkown)._AddRef;
//Do stuff with ObjectRef
(ObjectRef as IUnkown)._Release;

边注:
您发现没有出现 Stack Overflow 错误很奇怪。 (很明显你知道为什么会引发 AV。)我想指出通常递归只会触发 SO 错误:如果递归非常深(我的意思是非常)；或者如果每个递归在堆栈上分配相当大的内存量。