Pergunta

I'm trying to resolve this problem. It's weird because it doesn't throw a Stack Overflow error but an Access Violation error. (See code below.)

Whenever CallDestructor function is called, DestroyChildren is called. So it's a recursive function.

When I'm handling only a few objects it works fine. My trouble is when I have a lot of instances to destroy.

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.
Foi útil?

Solução 2

The detail was the difference.

TValueObject is a specialization of TAggregationObject and it implements IMasterValue, something like this:

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

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

So I have: TSomeService = class public function Find(AMasterValue: IMasterValue): TValueObject; end;

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;

//Occurs on great concurrency because the memory will be reused, otherwise the memory is still there hidding the problem. The threads running loop for destruction will show the problem.

The workaround for that, is:

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;

Outras dicas

OP managed to identify the problem, but hasn't posted an answer. I provide an edited version of his comment and add a more detailed explanation.

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.

The Access Violations aren't caused by mixing object references and interfaces; there are ways to do this safely.
But they are caused by the fact that Delphi attempts to _Release a reference on an object that has already been destroyed.

However this raises the question: "Why does the AV only happen sometimes, and not all the time?"

To explain, I'm going to talk about an illegal memory operation. By this I mean a piece of code (or object) that accesses memory it is not supposed to.

You don't get an AV every time your program performs an illegal memory operation. An AV will only be raised if the illegal memory operation is noticed! There are 2 main reasons it might be unnoticed:

  • It may be "illegal" for one object in your program to access certain memory, but if it is legal for another instance to access that memory - then there is no way for the system to notice that you've actually committed an illegal memory operation.
  • Most of the time, FastMem requests memory from the OS in larger "pages" than what you actually request from FastMem. It then keeps track of multiple smaller allocations on the page. The page is only returned to the OS when there are no smaller allocations left on the page. Therefore again, the OS won't notice any illegal memory operations on a page still allocated to your program.

The second reason above is why a small number of objects doesn't cause an AV: The page on which the object was allocated is still allocated to your program.
But when you have a large number of instances: sometimes when you destroy an object, it the last one on a page; and the page is returned to the OS... Therefore you get AV when _Release is called on that page.

So, how do you fix it?

Well, the option you chose (use an abstract class instead of an interface) works. But you lose the benefits of interfaces. However, I would suggest not trying to manually control the destruction of interface objects. One of the benefits of interface references is that the underlying objects will self-destruct (if you let them).

I suspect you're doing this because you're mixing object references and interface references. So instead of forcing your interfaces behave like objects (and you've gone to a lot of trouble to do so), rather simply let each of your object references manually add a reference to the interface. You can do this with the following code:

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

SIDE NOTE:
You found it weird that no Stack Overflow error was raised. (And obviously you figured out why the AV was raised.) I'd like to point out that typically recursion will only trigger SO errors: if the recursion is very deep (and I mean very); or if each recursion allocates a rather large amount of memory on the stack.

Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top