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

我正在尝试解决此问题。这很奇怪，因为它不会引发堆栈溢出错误，但是会引发访问冲突错误。 （请参见下面的代码。）

每当调用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.

最佳答案

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

我认为问题出在混合对象引用和接口。即使我的对象不受RefCount的控制，在后台也会发生一些事情：“但是，由于接口引用的性质，当引用超出范围时，_AddRef和_Release仍将被调用。那时，您在_IntfClear中有一个AV。”我在堆栈中的最后一个调用是_IntfClear或_IntfCopy。我认为这是问题所在。我不确定该如何更正，因此我已更改为抽象类。

访问冲突不是由混合对象引用和接口引起的；有一些方法可以安全地执行此操作。
但是，它们是由Delphi尝试对已被破坏的对象引用_Release的事实引起的。
但是，这引发了一个问题：“为什么AV仅在某些时间而不是所有时间发生？”
为了解释，我将讨论一个非法的内存操作。我的意思是一段不应该访问的代码（或对象）访问内存。
每次程序执行非法的内存操作时，您都不会获得AV。仅当发现非法存储操作时，才会发出AV！可能不引起注意的主要原因有两个：

程序中的一个对象访问某些内存可能是“非法的”，但是如果另一个实例访问该内存是合法的，那么系统将无法注意到您实际上已执行了非法的内存操作。
在大多数情况下，FastMem从操作系统中以比您实际从FastMem中请求的更大的“页面”中请求内存。然后，它会跟踪页面上的多个较小的分配。仅当页面上没有剩余的较小分配时，页面才会返回到OS。因此，再次提醒您，操作系统不会在仍然分配给您程序的页面上注意到任何非法的内存操作。

上面的第二个原因是为什么少量对象不会导致AV：分配对象的页面仍分配给您的程序。
但是，当您拥有大量实例时：有时销毁对象时，它是页面上的最后一个对象；并将页面返回到OS ...因此，当在该页面上调用_Release时，您将获得AV。
那么，如何解决呢？
好吧，您选择的选项（使用抽象类而不是接口）有效。但是您会失去接口的好处。但是，我建议不要尝试手动控制接口对象的销毁。接口引用的好处之一是底层对象将自毁（如果允许的话）。
我怀疑您正在执行此操作，因为您正在混合对象引用和接口引用。因此，与其强迫接口的行为像对象（这样做很麻烦），不如让每个对象引用手动添加对接口的引用。您可以使用以下代码执行此操作：

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

边注：
您发现没有引起堆栈溢出错误很奇怪。 （显然，您已经弄清楚了为什么提高AV的原因。）我想指出，通常，递归只会触发SO错误：如果递归非常深（我的意思是非常）；或者如果每个递归在堆栈上分配了相当大的内存。