Question

我正在尝试解决此问题。这很奇怪，因为它不会引发Stack Overflow错误，而是会引发Access Violation错误。（见下面的代码。）

每当调用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设法识别问题，但没有发布答案。我提供了他评论的编辑版本，并添加了更详细的解释。

我认为问题在于混合对象引用和接口。即使我的对象不受RefCount控制，也可以在后台进行操作：＆＃34;但是，由于接口引用的性质，当引用超出范围时，仍会调用_AddRef和_Release。如果该类在此之前已被销毁，那么您在_IntfClear中有一个AV。＆＃34;我在堆栈中的最后一次调用是_IntfClear或_IntfCopy。我认为这是问题所在。我不确定如何纠正，所以我已经改为抽象课。

访问冲突不是由混合对象引用和接口引起的;有办法安全地做到这一点但它们是由于Delphi尝试_Release对已经被破坏的对象的引用这一事实引起的。

但是这引出了一个问题：＆＃34;为什么AV有时只发生，而不是一直发生？＆＃34;

要解释一下，我将谈谈非法内存操作。我的意思是一段代码（或对象）访问它不应该的内存。

每次程序执行非法内存操作时，您都无法获得AV。只有非法内存操作 注意时才会引发AV！有两个主要原因可能会被忽视：

可能是非法的＆＃34;对于程序中的一个对象来访问某些内存，但如果合法的另一个实例访问该内存 - 那么系统无法注意到您实际上已经提交了非法内存操作。
大多数情况下，FastMem在更大的＆＃34;页面中从操作系统请求内存。而不是你实际从FastMem请求的。然后，它会跟踪页面上的多个较小分配。仅当页面上没有剩余较小的分配时，页面才会返回到操作系统。因此，操作系统再次在<仍然分配给您的程序的页面上注意 非法内存操作。

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

那么，你如何解决它？

嗯，你选择的选项（使用抽象类而不是接口）是有效的。但是你失去了接口的好处。但是，我建议不尝试手动控制界面对象的销毁。接口引用的一个好处是底层对象将自毁（如果你让它们，）。

我怀疑你这样做是因为你正在混合对象引用和接口引用。因此，不要强迫您的界面表现得像对象（并且您已经遇到了很多麻烦），而是简单地让每个对象引用手动添加对该界面的引用。您可以使用以下代码执行此操作：

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

侧面注意：
您发现没有引发Stack Overflow错误很奇怪。（显然你弄清楚为什么AV被提升了。）我想指出通常递归只会触发SO错误：如果递归非常深（我的意思是非常） ;或者如果每个递归在堆栈上分配相当大的内存。

Answer 2

细节是不同的。

TValueObject是TAggregationObject的一个特化，它实现了IMasterValue，如下所示：

IMasterValue = interface
  //GUID Here
  function MasterValue: variant;
end;

TValueObject = class(TAggregationObject , IMasterValue)
public
  function MasterValue: variant;
end;

所以我有： TSomeService = class 上市 function Find（AMasterValue：IMasterValue）：TValueObject; 端;

procedure DoSome(AValueObject: TValueObject);
begin
with TSomeService.Create() do
  begin
    try
      Find(AValueObject); //This will get cleared when method exits
    finally
      AValueObject.Free(); //But the object is destroyed before that
    end;  
  end;
end;

//在很好的并发性上发生，因为内存将被重用，否则内存仍然存在隐藏问题。运行循环以进行销毁的线程将显示问题。

解决方法是：

procedure DoSome(AValueObject: TValueObject);
var
  LMasterValue: IMasterValue;
begin
  with TSomeService.Create() do
  begin
    try
      LMasterValue := AValueObject;
      try
        Find(LMasterValue);
      finally
        LMasterValue := nil;        
      end;  
    finally
      AValueObject.Free();
    end;
  end;
end;

接口违反递归函数

2 个答案:

但是这引出了一个问题：＆＃34;为什么AV有时只发生，而不是一直发生？＆＃34;

那么，你如何解决它？