Access violation on recursive function with interfaces - delphi

Question

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.

Answer 1

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.

Answer 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;