In Delphi 10 Seattle I could use the following code to work around overly strict visibility restrictions.
How do I get access to private variables?
type
TBase = class(TObject)
private
FMemberVar: integer;
end;
And how do I get access to plain or virtual private methods?
type
TBase2 = class(TObject)
private
procedure UsefullButHidden;
procedure VirtualHidden; virtual;
procedure PreviouslyProtected; override;
end;
Previously I would use a class helper to break open the base class.
type
TBaseHelper = class helper for TBase
function GetMemberVar: integer;
In Delphi 10.1 Berlin, class helpers no longer have access to private members of the subject class or record.
Is there an alternative way to access private members?
If there is extended RTTI info generated for the class private members - fields and/or methods you can use it to gain access to them.
Of course, accessing through RTTI is way slower than it was through class helpers.
Accessing methods:
var
Base: TBase2;
Method: TRttiMethod;
Method := TRttiContext.Create.GetType(TBase2).GetMethod('UsefullButHidden');
Method.Invoke(Base, []);
Accessing variables:
var
Base: TBase;
v: TValue;
v := TRttiContext.Create.GetType(TBase).GetField('FMemberVar').GetValue(Base);
Default RTTI information generated for RTL/VCL/FMX classes is following
Fields - private, protected, public, published
Methods - public, published
Properties - public, published
Unfortunately, that means accessing private methods via RTTI for core Delphi libraries is not available. #LU RD's answer covers hack that allows private method access for classes without extended RTTI.
Working with RTTI
There is still a way to use class helpers for access of private methods in Delphi 10.1 Berlin:
type
TBase2 = class(TObject)
private
procedure UsefullButHidden;
procedure VirtualHidden; virtual;
procedure PreviouslyProtected; override;
end;
TBase2Helper = class helper for TBase2
procedure OpenAccess;
end;
procedure TBase2Helper.OpenAccess;
var
P : procedure of object;
begin
TMethod(P).Code := #TBase2.UsefullButHidden;
TMethod(P).Data := Self;
P; // Call UsefullButHidden;
// etc
end;
Unfortunately there is no way to access strict private/private fields by class helpers with Delphi 10.1 Berlin. RTTI is an option, but can be considered slow if performance is critical.
Here is a way to define the offset to a field at startup using class helpers and RTTI:
type
TBase = class(TObject)
private // Or strict private
FMemberVar: integer;
end;
type
TBaseHelper = class helper for TBase
private
class var MemberVarOffset: Integer;
function GetMemberVar: Integer;
procedure SetMemberVar(value: Integer);
public
class constructor Create; // Executed at program start
property MemberVar : Integer read GetMemberVar write SetMemberVar;
end;
class constructor TBaseHelper.Create;
var
ctx: TRTTIContext;
begin
MemberVarOffset := ctx.GetType(TBase).GetField('FMemberVar').Offset;
end;
function TBaseHelper.GetMemberVar: Integer;
begin
Result := PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^;
end;
procedure TBaseHelper.SetMemberVar(value: Integer);
begin
PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^ := value;
end;
This will have the benefit that the slow RTTI part is only executed once.
Note: Using RTTI for access of protected/private methods
The RTL/VCL/FMX have not declared visibility for access of protected/private methods with RTTI. It must be set with the local directive {$RTTI}.
Using RTTI for access of private/protected methods in other code requires for example setting :
{$RTTI EXPLICIT METHODS([vcPublic, vcProtected, vcPrivate])}
If you want a clean way that does not impact performance, you still can access private fields from a record helper using the with statement.
function TValueHelper.GetAsInteger: Integer;
begin
with Self do begin
Result := FData.FAsSLong;
end;
end;
I hope they keep this method open, because we have code with high performance demands.
Assuming that extended RTTI is not available, then without resorting to what would be considered hacking, you cannot access private members from code in a different unit. Of course, if RTTI is available it can be used.
It is my understanding that the ability to crack private members using helpers was an unintentional accident. The intention is that private members only be visible from code in the same unit, and strict private members only be visible from code in the same class. This change corrects the accident.
Without the ability to have the compiler crack the class for you, you would need to resort to other ways to do so. For instance, you could re-declare enough of the TBase class to be able to trick the compiler into telling you where a member lived.
type
THackBase = class(TObject)
private
FMemberVar: integer;
end;
Now you can write
var
obj: TBase;
....
MemberVar := THackBase(obj).FMemberVar;
But this is horrendously brittle and will break as soon as the layout of TBase is changed.
That will work for data members, but for non-virtual methods, you'd probably need to use runtime disassembly techniques to find the location of the code. For virtual members this technique can be used to find the VMT offset.
Further reading:
http://hallvards.blogspot.nl/2004/06/hack-5-access-to-private-fields.html
https://bitbucket.org/NickHodges/delphi-unit-tests/wiki/Accessing%20Private%20Members
If you don't need ARM compiler support, you can find another solution here.
With inline asembler, you can access private field or method, easily.
I think David's answer is better in most case, but if you need a quick solution for a huge class, this method could be more useful.
Update(June 17): I've just noticed, I forgot to share his sample code for accessing private fields from his post. sorry.
unit UnitA;
type
THoge = class
private
FPrivateValue: Integer;
procedure PrivateMethod;
end;
end.
unit UnitB;
type
THogeHelper = class helper for THoge
public
function GetValue: Integer;
procedure CallMethod;
end;
function THogeHelper.GetValue: Integer;
asm
MOV EAX,Self.FPrivateValue
end;
procedure THogeHelper.CallMethod;
asm
CALL THoge.PrivateMethod
end;
Here is his sample code for calling private method.
type
THoge = class
private
procedure PrivateMethod (Arg1, Arg2, Arg3 : Integer);
end;
// Method 1
// Get only method pointer (if such there is a need to assign a method pointer to somewhere)
type
THogePrivateProc = procedure (Self: THoge; Arg1, Arg2, Arg3: Integer);
THogePrivateMethod = procedure (Arg1, Arg2, Arg3: Integer) of object;
function THogeHelper.GetMethodAddr: Pointer;
asm
{$ifdef CPUX86}
LEA EAX, THoge.PrivateMethod
{$else}
LEA RAX, THoge.PrivateMethod
{$endif}
end;
var
hoge: THoge;
proc: THogePrivateProc;
method: THogePrivateMethod;
begin
// You can either in here of the way,
proc := hoge.GetMethodAddr;
proc (hoge, 1, 2, 3);
// Even here of how good
TMethod (method) .Code := hoge.GetMethodAddr;
TMethod (method) .Data := hoge;
method (1, 2, 3) ;
end;
// Method 2
// To jump (here is simple if you just simply call)
procedure THogeHelper.CallMethod (Arg1, Arg2, Arg3 : Integer);
asm
JMP THoge.PrivateMethod
end;
unit UnitA;
type
THoge = class
private
FPrivateValue: Integer;
procedure PrivateMethod;
end;
end.
Just use 'with' statement to access private fields !
See the sample code below, taken from this article I noticed today. (Thanks, Mr.DEKO as always !)
This hack is originally reported on QualityPortal in August 2019 as described on above aritcle. (login required)
before rewrite (using "asm" method)
function TPropertyEditorHelper.GetPropList: PInstPropList;
{$IF CompilerVersion < 31.0}
begin
Result := Self.FPropList;
end;
{$ELSE}
// http://d.hatena.ne.jp/tales/20160420/1461081751
asm
MOV EAX, Self.FPropList;
end;
{$IFEND}
rewrite using 'with'
function TPropertyEditorHelper.GetPropList: PInstPropList;
begin
with Self do
Result := FPropList;
end;
I was amazed it's so simple :-)
Related
I have a logging class, which links to many modules. The main method of this class is a class method:
type
TSeverity = (seInfo, seWarning, seError);
TLogger = class
class procedure Log(AMessage: String; ASeverity: TSeverity);
end;
Somewhere else I have a function DoSomething() which does some things that I would like to log. However, I do not want to link all the modules of the logger to the module in which 'DoSomething()' is declared to use the logger. Instead I would like to pass an arbitrary logging method as a DoSomething's parameter and call it from its body.
The problem is that TLogger.Log requires parameter of TSeverity type which is defined in logger class. So I can't define a type:
type
TLogProcedure = procedure(AMessage: String; ASverity: TSeverity) of Object;
because I would have to include an unit in which TSeverity is declared.
I was trying to come up with some solution based on generic procedure but I am stuck.
uses
System.SysUtils;
type
TTest = class
public
class function DoSomething<T1, T2>(const ALogProcedure: TProc<T1,T2>): Boolean; overload;
end;
implementation
class function TTest.DoSomething<T1, T2>(const ALogProcedure: TProc<T1, T2>): Boolean;
var
LMessage: String;
LSeverity: Integer;
begin
//Pseudocode here I would like to invoke logging procedure here.
ALogProcedure(T1(LMessage), T2(LSeverity));
end;
Somewehere else in the code I would like to use DoSomething
begin
TTest.DoSomething<String, TSeverity>(Log);
end;
Thanks for help.
Update
Maybe I didn't make myself clear.
unit uDoer;
interface
type
TLogProcedure = procedure(AMessage: String; AErrorLevel: Integer) of Object;
// TDoer knows nothing about logging mechanisms that are used but it allows to pass ALogProcedure as a parameter.
// I thoight that I can somehow generalize this procedure using generics.
type
TDoer = class
public
class function DoSomething(const ALogProcedure: TLogProcedure): Boolean;
end;
implementation
class function TDoer.DoSomething(const ALogProcedure: TLogProcedure): Boolean;
begin
ALogProcedure('test', 1);
Result := True;
end;
end.
Separate unit with one of the logging mechanisms.
unit uLogger;
interface
type
TSeverity = (seInfo, seWarning, seError);
// I know that I could solve my problem by introducing an overloaded method but I don't want to
// do it like this. I thought I can use generics somehow.
TLogger = class
class procedure Log(AMessage: String; ASeverity: TSeverity); {overload;}
{class procedure Log(AMessage: String; ASeverity: Integer); overload;}
end;
implementation
class procedure TLogger.Log(AMessage: String; ASeverity: TSeverity);
begin
//...logging here
end;
{class procedure TLogger.Log(AMessage: String; ASeverity: Integer);
begin
Log(AMessage, TSeverity(ASeverity));
end;}
end.
Sample usage of both units.
implementation
uses
uDoer, uLogger;
procedure TForm10.FormCreate(Sender: TObject);
begin
TDoer.DoSomething(TLogger.Log); //Incompatible types: Integer and TSeverity
end;
Introducing generics here does not help. The actual parameters that you have are not generic. They have fixed type, string and Integer. The function you are passing them to is not generic and receives parameters of type string and TSeverity. These types are mis-matched.
Generics won't help you here because your types are all known ahead of time. There is nothing generic here. What you need to do, somehow, is convert between Integer and TSeverity. Once you can do that then you can call your function.
In your case you should pass a procedure that accepts an Integer, since you don't have TSeverity available at the point where you call the procedure. Then in the implementation of that procedure, where you call the function that does accept a TSeverity, that's where you convert.
In scenarios involving generic procedural types, what you have encountered is quite common. You have a generic procedural type like this:
type
TMyGenericProcedure<T> = procedure(const Arg: T);
In order to call such a procedure you need an instance of T. If you are calling the procedure from a function that is generic on T, then your argument must also be generic. In your case that argument is not generic, it is fixed as Integer. At that point your attempt to use generics unravels.
Having said all of that, what you describe doesn't really hang together at all. How can you possibly come up with the severity argument if you don't know what TSeverity is at that point? That doesn't make any sense to me. How can you just conjure up an integer value and hope that it matches this enumerated type? Some mild re-design would enable you to do this quite simply without any type conversions.
As David Heffernan says, you cannot use generics in this way. Instead you should use a function to map the error level to a severity type, and use that to glue together the two. Based on your updated example, one could modify it like this:
unit uDoer;
interface
type
TLogProcedure = reference to procedure(const AMessage: String; AErrorLevel: Integer);
// TDoer knows nothing about logging mechanisms that are used but it allows to pass ALogProcedure as a parameter.
type
TDoer = class
public
class function DoSomething(const ALogProcedure: TLogProcedure): Boolean;
end;
implementation
class function TDoer.DoSomething(const ALogProcedure: TLogProcedure): Boolean;
begin
ALogProcedure('test', 1);
Result := True;
end;
end.
You can then provide the glue procedure which converts the error level to a severity:
implementation
uses
uDoer, uLogger;
function SeverityFromErrorLevel(const AErrorLevel: Integer): TSeverity;
begin
if (AErrorLevel <= 0) then
result := seInfo
else if (AErrorLevel = 1) then
result := seWarning
else
result := seError;
end;
procedure LogProc(const AMessage: String; AErrorLevel: Integer);
var
severity: TSeverity;
begin
severity := SeverityFromErrorLevel(AErrorLevel);
TLogger.Log(AMessage, severity);
end;
procedure TForm10.FormCreate(Sender: TObject);
begin
TDoer.DoSomething(LogProc);
end;
Note I didn't compile this, but the essence is there. I used a procedure reference (reference to procedure) as they're a lot more flexible, which may come in handy later.
Delphi has a nasty habit of duplicating code for generic classes. Even if that code is really the same, because the generic types are similar.
I want to prevent duplication for storing different classes.
In my generic container I only use Free to clean up if needed.
Suppose I have a generic container like so:
unit Unit1;
interface
uses Generics.Collections;
type
TMyContainer<T> = class(TObject)
strict private
FData: TList<T>;
public
constructor Create; virtual;
end;
I know T will often be an object. Because all objects are really TObject I don't want my container to create duplicate generic code for different types of objects.
Will the following trick work to prevent duplication?
A- Substitute the constructor with a class function:
unit Unit2;
uses Unit1;
type
TMyContainer<T> = class(Unit1.TMyContainer<T>)
public
class function Create: TMyContainer<T>; static;
end;
B: implement the class function Create like so:
class function TMyContainer<T>.Create: TMyContainer<T>;
var
X: TObject;
begin
if GetTypeKind(T) = tkClass then begin
X:= Unit1.TMyContainer<TObject>.Create;
end else begin
X:= Unit1.TMyContainer<T>.Create;
end;
TObject(Result):= X;
end;
Will this trick work to prevent the compiler from generating duplicate code for different types of objects, or will this fail because I'm using incorrect assumptions?
Note that I don't want to resort to using a non-generic store for my data.
Full sample code follows
unit Unit49;
interface
uses Generics.Collections;
type
TMyContainer<T> = class(TObject)
strict private
FData: TList<T>;
public
constructor Create; virtual;
end;
implementation
constructor TMyContainer<T>.Create;
begin
inherited Create;
FData:= TList<T>.Create;
end;
end.
Sample program
program Project85;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Unit49 in 'Unit49.pas';
type
TMyContainer<T> = class(Unit49.TMyContainer<T>)
public
class function Create: TMyContainer<T>; static;
end;
{ TMyContainer<T> }
class function TMyContainer<T>.Create: TMyContainer<T>;
var
Y: T;
X: TObject;
begin
if GetTypeKind(T) = tkClass then begin
X:= Unit49.TMyContainer<TObject>.Create;
end else begin
X:= Unit49.TMyContainer<T>.Create;
end;
TObject(Result):= X;
end;
var
A: TMyContainer<TObject>;
B: TMyContainer<TLanguages>;
begin
A:= TMyContainer<TObject>.Create;
B:= TMyContainer<TLanguages>.Create;
readln;
end.
Will this trick work to prevent the compiler from generating duplicate
code for different types of objects, or will this fail because I'm
using incorrect assumptions?
No, it will not work.
Basically, compiler follows your T through whole class hierarchy and replaces it with specific type.
For start, you will have separate TList<T> code generated for both TObject and TLanguages because your container is declared as FData: TList<T>, then
your trick collection also inherits from generic T TMyContainer<T> = class(Unit49.TMyContainer<T>) and whole code in your class function is basically useless.
Compiler will generate duplicate code for Unit49.TMyContainer<TLanguages> class as well as Unit49.TMyContainer<TObject> class.
From your example it is hard to say what code duplication are you trying to avoid. If container class is as simple as you have written in your example, then all code duplication will come from TList<T> class. If you are trying to avoid that one, there is no easy way out.
Part of your problem comes from fact that you have T that can be anything. It is hard to optimize it. The most optimization you could get is using array of T for storing data and then delegating manipulation functions where you can use TObject as base for all classes and plain T for others.
How much can you gain with above also depends on which Delphi version do you use, because in most recent versions TList<T> has been optimized a bit with similar techniques.
However, if you can have separate containers for class and other types then you can achieve code folding for TObject and descendant containers using TObjectList<TObject> (or even non generic TObjectList on Windows) for storing all specific classes and implementing thin wrapper functions with typecast for any type safe functions you need. Of course, each such function will have some code generated for each specific type, but since they are just typecast wrappers that will not be as much code as it would be if you would use full TList<T> for each class type.
TMyObjectContainer<T> = class(TObject)
strict private
FData: TObjectList<TObject>;
public
constructor Create; virtual;
destructor Destroy; override;
function Data(index: integer): T;
end;
constructor TMyObjectContainer<T>.Create;
begin
inherited;
FData := TObjectList<TObject>.Create;
end;
constructor TMyObjectContainer<T>.Create;
begin
FData.Free;
inherited;
end;
function TMyObjectContainer<T>.Data(index: integer): T;
begin
Result := T(FData.Items[index]);
end;
I would like to use Gabriel Corneanu's jpegex, a class helper for jpeg.TJPEGImage.
Reading this and this I've learned that beyond Delphi Seattle you cannot access private fields anymore like jpegex does (FData in the example below). Poking around with the VMT like David Heffernan proposed is far beyond me. Is there any easier way to get this done?
type
// helper to access TJPEGData fields
TJPEGDataHelper = class helper for TJPEGData
function Data: TCustomMemoryStream; inline;
procedure SetData(D: TCustomMemoryStream);
procedure SetSize(W,H: integer);
end;
// TJPEGDataHelper
function TJPEGDataHelper.Data: TCustomMemoryStream;
begin
Result := self.FData;
end;
Today I found a neat way around this bug using the with statement.
function TValueHelper.GetAsInteger: Integer;
begin
with Self do begin
Result := FData.FAsSLong;
end;
end;
Besides that Embarcadero did a nice job building walls to protect the private parts and that's probably why they named it 10.1 Berlin.
Beware! This is a nasty hack and can fail when the internal field structure of the hacked class changes.
type
TJPEGDataHack = class(TSharedImage)
FData: TCustomMemoryStream; // must be at the same relative location as in TJPEGData!
end;
// TJPEGDataHelper
function TJPEGDataHelper.Data: TCustomMemoryStream;
begin
Result := TJPEGDataHack(self).FData;
end;
This will only work if the parent class of the "hack" class is the same as the parent class of the original class. So, in this case, TJPEGData inherits from TSharedImage and so does the "hack" class. The positions also need to match up so if there was a field before FData in the list then an equivalent field should sit in the "hack" class, even if it's not used.
A full description of how it works can be found here:
Hack #5: Access to private fields
By using a combination of a class helper and RTTI, it is possible to have the same performance as previous Delphi versions using class helpers.
The trick is to resolve the offset of the private field at startup using RTTI, and store that inside the helper as a class var.
type
TBase = class(TObject)
private // Or strict private
FMemberVar: integer;
end;
type
TBaseHelper = class helper for TBase // Can be declared in a different unit
private
class var MemberVarOffset: Integer;
function GetMemberVar: Integer;
procedure SetMemberVar(value: Integer);
public
class constructor Create; // Executed automatically at program start
property MemberVar : Integer read GetMemberVar write SetMemberVar;
end;
class constructor TBaseHelper.Create;
var
ctx: TRTTIContext;
begin
MemberVarOffset := ctx.GetType(TBase).GetField('FMemberVar').Offset;
end;
function TBaseHelper.GetMemberVar: Integer;
begin
Result := PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^;
end;
procedure TBaseHelper.SetMemberVar(value: Integer);
begin
PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^ := value;
end;
As you can see it requires a bit of extra typing, but compared to patching a whole unit, it is simple enough.
I ran into a strange situation while testing something today.
I have a number of interfaces and objects. The code looks like this:
IInterfaceZ = interface(IInterface)
['{DA003999-ADA2-47ED-A1E0-2572A00B6D75}']
procedure DoSomething;
end;
IInterfaceY = interface(IInterface)
['{55BF8A92-FCE4-447D-B58B-26CD9B344EA7}']
procedure DoNothing;
end;
TObjectB = class(TInterfacedObject, IInterfaceZ)
procedure DoSomething;
end;
TObjectC = class(TInterfacedObject, IInterfaceY)
public
FTest: string;
procedure DoNothing;
end;
TObjectA = class(TInterfacedObject, IInterfaceZ, IInterfaceY)
private
FInterfaceB: IInterfaceZ;
FObjectC: TObjectC;
function GetBB: IInterfaceZ;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
property BB: IInterfaceZ read GetBB implements IInterfaceZ;
property CC: TObjectC read FObjectC implements IInterfaceY;
end;
procedure TObjectB.DoSomething;
begin
Sleep(1000);
end;
procedure TObjectA.AfterConstruction;
begin
inherited;
FInterfaceB := TObjectB.Create;
FObjectC := TObjectC.Create;
FObjectC.FTest := 'Testing';
end;
procedure TObjectA.BeforeDestruction;
begin
FreeAndNil(FObjectC);
FInterfaceB := nil;
inherited;
end;
function TObjectA.GetBB: IInterfaceZ;
begin
Result := FInterfaceB;
end;
procedure TObjectC.DoNothing;
begin
ShowMessage(FTest);
end;
Now if I access the various implementations like this I get the following results:
procedure TestInterfaces;
var
AA: TObjectA;
YY: IInterfaceY;
ZZ: IInterfaceZ;
NewYY: IInterfaceY;
begin
AA := TObjectA.Create;
// Make sure that the Supports doesn't kill the object.
// This line of code is necessary in XE2 but not in XE4
AA._AddRef;
// This will add one to the refcount for AA despite the fact
// that AA has delegated the implementation of IInterfaceY to
// to FObjectC.
Supports(AA, IInterfaceY, YY);
YY.DoNothing;
// This will add one to the refcount for FInterfaceB.
// This is also allowing a supports from a delegated interface
// to another delegated interface.
Supports(YY, IInterfaceZ, ZZ);
ZZ.DoSomething;
// This will fail because the underlying object is actually
// the object referenced by FInterfaceB.
Supports(ZZ, IInterfaceY, NewYY);
NewYY.DoNothing;
end;
The first Supports call, which uses the variable in the implements, returns YY which is actually a reference to TObjectA. My AA variable is reference counted. Because the underlying reference counted object is a TObjectA, the second supports, which uses the interface in the supports call, works and returns me an interface. The underlying object is actually now a TObjectB. The internal object behind FInterfaceB is the object being reference counted. This part makes sense because GetBB is actually FInterfaceB. As expected here, the last call to Supports returns a null for NewYY and the call at the end fails.
My question is this, is the reference counting on TObjectA with the first supports call by design? In other words, when the property that implements the interface is returning an object and not an interface does this mean that the owner object will be the one doing the reference counting? I was always under the impression that implements would also result in the internal delegated object being reference counted instead of the main object.
The declarations are as follows:
property BB: IInterfaceZ read GetBB implements IInterfaceZ;
With this option above, the internal object behind FInterfaceB is the one that is reference counted.
property CC: TObjectC read FObjectC implements IInterfaceY;
With this second option above, TObjectA is the one that is being reference counted and not the delegated object FObjectC.
Is this by design?
Edit
I just tested this in XE2 and the behavior is different. The second Supports statement returns nil for ZZ. The debugger in XE4 tells me that the YY is referring to (TObjectA as IInterfaceY). In XE2 it tells me that its a (Pointer as IInterfaceY). Also, in XE2, the AA is not ref counted on the first support statement but the internal FObjectC is reference counted.
Additional Information after the question answered
There is one caveat to this. You can chain the Interface version but not the object version. That means that something like this will work:
TObjectBase = class(TInterfacedObject, IMyInterface)
…
end;
TObjectA = class(TInterfacedObject, IMyInterface)
FMyInterfaceBase: IMyInterface;
property MyDelegate: IMyInterface read GetMyInterface implements IMyInterface;
end;
function TObjectA.GetMyInterface: IMyInterface;
begin
result := FMyInterfaceBase;
end;
TObjectB = class(TInterfacedObject, IMyInterface)
FMyInterfaceA: IMyInterface;
function GetMyInterface2: IMyInterface;
property MyDelegate2: IMyInterface read GetMyInterface2 implements IMyInterface;
end;
function TObjectB.GetMyInterface2: IMyInterface;
begin
result := FMyInterfaceA;
end;
But the object version gives a compiler error with this saying that TObjectB doesn't implement the methods for the interface.
TObjectBase = class(TInterfacedObject, IMyInterface)
…
end;
TObjectA = class(TInterfacedObject, IMyInterface)
FMyObjectBase: TMyObjectBase;
property MyDelegate: TMyObjectBase read FMyObjectBase implements IMyInterface;
end;
TObjectB = class(TInterfacedObject, IMyInterface)
FMyObjectA: TObjectA;
property MyDelegate2: TObjectA read FMyObjectA implements IMyInterface;
end;
So if you want to start chaining the delegation then you need to stick to interfaces or work around it another way.
tl;dr This is all by design – it's just that the design changes between XE2 and XE3.
XE3 and later
There is quite a difference between delegation to an interface type property and delegation to a class type property. Indeed the documentation calls out this difference explicitly with different sections for the two delegation variants.
The difference from your perspective is as follows:
When TObjectA implements IInterfaceY by delegating to class type property CC, the implementing object is the instance of TObjectA.
When TObjectA implements IInterfaceZ by delegating to interface type property BB, the implementing object is the object that implements FInterfaceB.
One key thing to realise in all this is that when you delegate to a class type property, the class that is delegated to need not implement any interfaces. So it need not implement IInterface and so need not have _AddRef and _Release methods.
To see this, modify your code's definition of TObjectC to be like so:
TObjectC = class
public
procedure DoNothing;
end;
You will see that this code compiles, runs, and behaves exactly the same way as does your version.
In fact this is ideally how you would declare a class to which an interface is delegated as a class type property. Doing it this way avoids the lifetime issues with mixing interface and class type variables.
So, let's look at your three calls to Supports:
Supports(AA, IInterfaceY, YY);
Here the implementing object is AA and so the reference count of AA is incremented.
Supports(YY, IInterfaceZ, ZZ);
Here the implementing object is the instance of TObjectB so its reference count is incremented.
Supports(ZZ, IInterfaceY, NewYY);
Here, ZZ is an interface implemented by the instance of TObjectB which does not implement IInterfaceY. Hence Supports returns False and NewYY is nil.
XE2 and earlier
The design changes between XE2 and XE3 coincide with the introduction of the mobile ARM compiler and there were many low-level changes to support ARC. Clearly some of these changes apply to the desktop compilers too.
The behavioural difference that I can find concerns delegation of interface implementation to class type properties. And specifically when the class type in question supports IInterface. In that scenario, in XE2, the reference counting is performed by the inner object. That differs from XE3 which has the reference counting performed by the outer object.
Note that for a class type that does not support IInterface, the reference counting is performed by the outer object in all versions. That makes sense since there's no way for the inner object to do it.
Here's my example code to demonstrate the difference:
{$APPTYPE CONSOLE}
uses
SysUtils;
type
Intf1 = interface
['{56FF4B9A-6296-4366-AF82-9901A5287BDC}']
procedure Foo;
end;
Intf2 = interface
['{71B0431C-DB83-49F0-B084-0095C535AFC3}']
procedure Bar;
end;
TInnerClass1 = class(TObject, Intf1)
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
procedure Foo;
end;
TInnerClass2 = class
procedure Bar;
end;
TOuterClass = class(TObject, Intf1, Intf2)
private
FInnerObj1: TInnerClass1;
FInnerObj2: TInnerClass2;
public
constructor Create;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
property InnerObj1: TInnerClass1 read FInnerObj1 implements Intf1;
property InnerObj2: TInnerClass2 read FInnerObj2 implements Intf2;
end;
function TInnerClass1.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TInnerClass1._AddRef: Integer;
begin
Writeln('TInnerClass1._AddRef');
Result := -1;
end;
function TInnerClass1._Release: Integer;
begin
Writeln('TInnerClass1._Release');
Result := -1;
end;
procedure TInnerClass1.Foo;
begin
Writeln('Foo');
end;
procedure TInnerClass2.Bar;
begin
Writeln('Bar');
end;
constructor TOuterClass.Create;
begin
inherited;
FInnerObj1 := TInnerClass1.Create;
end;
function TOuterClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TOuterClass._AddRef: Integer;
begin
Writeln('TOuterClass._AddRef');
Result := -1;
end;
function TOuterClass._Release: Integer;
begin
Writeln('TOuterClass._Release');
Result := -1;
end;
var
OuterObj: TOuterClass;
I1: Intf1;
I2: Intf2;
begin
OuterObj := TOuterClass.Create;
Supports(OuterObj, Intf1, I1);
Supports(OuterObj, Intf2, I2);
I1.Foo;
I2.Bar;
I1 := nil;
I2 := nil;
Readln;
end.
The output on XE2 is:
TInnerClass1._AddRef
TOuterClass._AddRef
Foo
Bar
TInnerClass1._Release
TOuterClass._Release
The output on XE3 is:
TOuterClass._AddRef
TOuterClass._AddRef
Foo
Bar
TOuterClass._Release
TOuterClass._Release
Discussion
Why did the design change? I cannot answer that definitively, not being privy to the decision making. However, the behaviour in XE3 feels better to me. If you declare a class type variable you would expect its lifetime to be managed as any other class type variable would be. That is, by explicit calls to destructor on the desktop compilers, and by ARC on the mobile compilers.
The behaviour of XE2 on the other hand feels inconsistent. Why should the fact that a property is used for interface implementation delegation change the way its lifetime is managed?
So, my instincts tell me that this was a design flaw, at best, in the original implementation of interface implementation delegation. The design flaw has led to confusion and lifetime management troubles over the years. The introduction to ARC forced Embarcadero to review this issue and they changed the design. My belief is that the introduction of ARC required a design change because Embarcadero have a track record of not changing behaviour unless absolutely necessary.
The paragraphs above are clearly speculation on my part, but that's the best I have to offer!
You are mixing object pointers and interface pointers, which is always a recipe for disaster. TObjectA is not incrementing the reference count of its inner objects to ensure they stay alive for its entire lifetime, and TestInterfaces() is not incrementing the reference count of AA to ensure it survives through the entire set of tests. Object pointers DO NOT participate in reference counting! You have to manage it manually, eg:
procedure TObjectA.AfterConstruction;
begin
inherited;
FObjectB := TObjectB.Create;
FObjectB._AddRef;
FObjectC := TObjectC.Create;
FObjectC._AddRef;
FObjectC.FTest := 'Testing';
end;
procedure TObjectA.BeforeDestruction;
begin
FObjectC._Release;
FObjectB._Release;
inherited;
end;
AA := TObjectA.Create;
AA._AddRef;
Needless to say, manual reference counting undermines the use of interfaces.
When dealing with interfaces, you need to either:
Disable reference counting completely to avoid premature destructions. TComponent, for instance, does exactly that.
Do EVERYTHING using interface pointers, NEVER with object pointers. This ensures proper reference counting across the board. This is generally the preferred solution.
I need to fix a third-party component. This component's class has private variable which is actively used by its descendants:
TThirdPartyComponentBase = class
private
FSomeVar: Integer;
public
...
end;
TThirdPartyComponent = class (TThirdPartyComponentBase)
protected
procedure Foo; virtual;
end;
procedure TThirdPartyComponent.Foo;
begin
FSomeVar := 1; // ACCESSING PRIVATE FIELD!
end;
This works because both classes are in the same unit, so they're kinda "friends".
But if I'll try to create a new class in a new unit
TMyFixedComponent = class (TThirdPartyComponent)
procedure Foo; override;
end;
I can't access FSomeVar anymore, but I need to use it for my fix. And I really don't want to reproduce in my code all that tree of base classes.
Can you advise some quick hack to access that private field without changing the original component's unit if it's possible at all?
By the use of class helpers it's possible to accomplish access to the private parts of the base class from the derived class without loosing type safety.
Just add these declarations in another unit:
Uses YourThirdPartyComponent;
type
// A helper to the base class to expose FSomeVar
TMyBaseHelper = class helper for TThirdPartyComponentBase
private
procedure SetSomeVar( value : integer);
function GetSomeVar: integer;
public
property SomeVar:integer read GetSomeVar write SetSomeVar;
end;
TMyFixedComponent = class helper for TThirdPartyComponent
protected
procedure Foo;
end;
procedure TMyFixedComponent.Foo;
begin
// Cast to base class and by the class helper TMyBaseHelper the access is resolved
TThirdPartyComponentBase(Self).SomeVar := 1;
end;
function TMyBaseHelper.GetSomeVar: integer;
begin
Result := Self.FSomeVar; // ACCESSING PRIVATE FIELD!
end;
procedure TMyBaseHelper.SetSomeVar(value: integer);
begin
Self.FSomeVar := value; // ACCESSING PRIVATE FIELD!
end;
// Testing
var
TSV: TThirdPartyComponent;
begin
TSV := TThirdPartyComponent.Create;
try
TSV.Foo;
WriteLn(IntToStr(TSV.SomeVar)); // Writes 1
finally
TSV.Free;
end;
end.
As can be seen from comments in code, FSomeVar is exposed by a class helper from the TThirdPartyComponentBase class.
Another class helper for the TThirdPartyComponent implements the Foo procedure. In there, access to the SomeVar property of the base class helper is made via a type cast to the base class.
You have to use a hack to access a private field in any class (including a base class) in a different unit. In your case define in your unit:
type
__TThirdPartyComponentBase = class
private
FSomeVar: Integer;
end;
Then get the access:
__TThirdPartyComponentBase(Self).FSomeVar := 123;
Of course, that is dangerous, because you will need to control changes in the base class. Because if the fields layout will be changed and you will miss this fact, then the above approach will lead to failures, AV's, etc.
Don't know if this will help, but I seem to recall there is a way to "crack" a private variable into visibility.
I know, for example, I've encountered warnings from the compiler when I've moved a property from lower visibility (in the base class) to a more visible level (in my descendant). The warning stated that it's being declared at a different level of visibility...
It's been some time and I'm not certain, but I believe what you can do is in your descendant declare the same variable as protected. (You may have to use the Redeclare keyword for this to compile.)
Sorry I don't have more specific information on how to do this (if it's indeed possible.) Perhaps this posting will prompt one of the wizards here into correcting me! :-)
Expose the value of the private variable by a protected property in TThirdPartyComponent.
TThirdPartyComponent = class (TThirdPartyComponentBase)
private
Procedure SetValue(Value: Integer);
Function GetValue: Integer;
protected
Property MyVar: Integer read GetValue write Setvalue;
procedure Foo; virtual;
end;
Procedure TThirdPartyComponent.SetValue(Value: Integer);
begin
FSomeVar := Value ;
end;
Function GetValue: Integer;
begin
result := FSomeVar;
end;
In TMyFixedComponent class use the MyVar Property in the procedure which you would like to override.