I was mystified by an Access Violation in Delphi code I was entrusted to maintain and eventually managed to boil it down to the example below. Any suggestions on how to make the example easier to understand are welcome.
What seems to be happening is, calling the inherited SetInterface method somehow corrupts the FInterface reference, so accessing it via the container thereafter leads to crashes. The original class instance implementing the interface seems to remain uncorrupted, as well as the interface reference outside of container. Re-implementing SetInterface using the generic I type, fixes it.
Is this a Delphi bug or simply a feature ?
(I know that casting the interface back to the implementing class is a bad practice, but the code I am dealing with uses such constructs and I cannot rewrite it all)
type
TInterfaceContainer = class
FInterface: IInterface;
procedure SetInterface(const AInterface: IInterface);
function GetInterface: IInterface;
end;
TInterfaceContainerGenericDescendant<I: IInterface> = class(TInterfaceContainer)
function GetInterface: I;
//procedure SetInterface(const AInterface: I); //this fixes the crash, why ?
end;
ITest = interface
function GetValue: Int64;
procedure SetValue(AValue: Int64);
end;
TTest = class(TInterfacedObject, ITest)
FValue: Int64;
function GetValue: Int64;
procedure SetValue(AValue: Int64);
end;
procedure Test;
begin
var aInterfaceContainer := TInterfaceContainerGenericDescendant<ITest>.Create;
try
var aTest: ITest := TTest.Create;
aTest.SetValue(11);
var aTestInstance := aTest as TTest;
aInterfaceContainer.SetInterface(aTestInstance);
var aValue := aTest.GetValue;
aValue := aTestInstance.GetValue;
aValue := aInterfaceContainer.GetInterface.GetValue; //AV on this line. Why ?
finally
aInterfaceContainer.Free
end
end;
{ TInterfaceContainer }
function TInterfaceContainer.GetInterface: IInterface;
begin
result := FInterface
end;
procedure TInterfaceContainer.SetInterface(const AInterface: IInterface);
begin
FInterface := AInterface
end;
{ TInterfaceContainerGenericDescendant<I> }
function TInterfaceContainerGenericDescendant<I>.GetInterface: I;
begin
result := I(inherited GetInterface)
end;
//procedure TInterfaceContainerGenericDescendant<I>.SetInterface( const AInterface: I);
//begin
// inherited SetInterface(AInterface)
//end;
{ TTest }
function TTest.GetValue: Int64;
begin
result := FValue
end;
procedure TTest.SetValue(AValue: Int64);
begin
FValue := AValue
end;
When you implement some interface with TInterfacedObject
you have to be aware that this class already implements IInterface
.
These lines are defective:
var aTestInstance := aTest as TTest;
aInterfaceContainer.SetInterface(aTestInstance);
What happens here is that in the second line, it gets the IInterface
reference from TTest
which inherits from TInterfacedObject
and thus you get the IMT for IInterface
- but that one is different from the IMT of ITest
. Inside your generic class you assume that the IInterface
you have stored in TInterfaceContainer
can be hardcasted to I
which is ITest
- but because you stored the IInterface
from TInterfacedObject
this is a wrong assumption and thus you get the AV because when calling GetValue
you access a virtual method index (3, the first 3 are those from IInterface
) that IInterface
simply does not have and it calls into an invalid code address.
The correction would be this:
aInterfaceContainer.SetInterface(aTest);
Every interface is an IInterface
- passing the ITest
reference to the non-generic SetInterface
ensures that it's the correct IMT and not the one that is only an IInterface
one. Also, this explains why the commented-out method fixes the issue - because then when passing the TTest
it properly gets the correct IMT for ITest
from it instead of the IInterface
one.
I suggest you add the generic more typesafe method to avoid passing IInterface
references that are not compatible with what you specify for I
in the generic class.