Rtti accessing fields and properties in complex data structures
As already discussed in Rtti data manipulation and consistency in Delphi 2010 a consistency between the original data and rtti values can be reached by accessing members by using a pair of TRttiField and an instance pointer. This would be very easy in case of a simple class with only basic member types (like e.g. integers or strings). But what if we have structured field types?
Here is an example:
TIntArray = array [0..1] of Integer;
TPointArray = array [0..1] of Point;
TExampleClass = class
private
FPoint : TPoint;
FAnotherClass : TAnotherClass;
FIntArray : TIntArray;
FPointArray : TPointArray;
public
property Point : TPoint read FPoint write FPoint;
//.... and so on
end;
For an easy access of Members I want to buil a tree of member-nodes, which provides an interface for getting and setting values, getting attributes, serializing/deserializing values and so on.
TMemberNode = class
private
FMember : TRttiMember;
FParent : TMemberNode;
FInstance : Pointer;
public
property Value : TValue read GetValue write SetValue; //uses FInstance
end;
So the most important thing is getting/setting the values, which is done - as stated before - by using the GetValue and SetValue functions of TRttiField.
So what is the Instance for FPoint members? Let's say Parent is the Node for TExample class, where the instance is known and the member is a field, then Instance would be:
FInstance := Pointer (Integer (Parent.Instance) + TRttiField (FMember).Offset);
But what if I want to know the Instance for a record property? There is no offset in this case. So is there a better solution to get a pointer to the data?
For the FAnotherClass member, the Instance would be:
FInstance := Parent.Value.AsObject;
So far the solution works, and data manipulation can be done by using rtti or the original types, without losing information.
But things get harder, when working with arrays. Especially the second array of Points. How can I get the instance for the members of points in this case?
Answer
TRttiField.GetValue where the field's type is a value type gets you a copy. This is by design. TValue.MakeWithoutCopy is for managing reference counts on things like interfaces and strings; it is not for avoiding this copy behaviour. TValue is intentionally not designed to mimic Variant's ByRef behaviour, where you can end up with references to (e.g.) stack objects inside a TValue, increasing the risk of stale pointers. It would also be counter-intuitive; when you say GetValue, you should expect a value, not a reference.
Probably the most efficient way to manipulate values of value types when they are stored inside other structures is to step back and add another level of indirection: by calculating offsets rather than working with TValue directly for all the intermediary value typed steps along the path to the item.
This can be encapsulated fairly trivially. I spent the past hour or so writing up a little TLocation record which uses RTTI to do this:
type
TLocation = record
Addr: Pointer;
Typ: TRttiType;
class function FromValue(C: TRttiContext; const AValue: TValue): TLocation; static;
function GetValue: TValue;
procedure SetValue(const AValue: TValue);
function Follow(const APath: string): TLocation;
procedure Dereference;
procedure Index(n: Integer);
procedure FieldRef(const name: string);
end;
function GetPathLocation(const APath: string; ARoot: TLocation): TLocation; forward;
{ TLocation }
type
PPByte = ^PByte;
procedure TLocation.Dereference;
begin
if not (Typ is TRttiPointerType) then
raise Exception.CreateFmt('^ applied to non-pointer type %s', [Typ.Name]);
Addr := PPointer(Addr)^;
Typ := TRttiPointerType(Typ).ReferredType;
end;
procedure TLocation.FieldRef(const name: string);
var
f: TRttiField;
begin
if Typ is TRttiRecordType then
begin
f := Typ.GetField(name);
Addr := PByte(Addr) + f.Offset;
Typ := f.FieldType;
end
else if Typ is TRttiInstanceType then
begin
f := Typ.GetField(name);
Addr := PPByte(Addr)^ + f.Offset;
Typ := f.FieldType;
end
else
raise Exception.CreateFmt('. applied to type %s, which is not a record or class',
[Typ.Name]);
end;
function TLocation.Follow(const APath: string): TLocation;
begin
Result := GetPathLocation(APath, Self);
end;
class function TLocation.FromValue(C: TRttiContext; const AValue: TValue): TLocation;
begin
Result.Typ := C.GetType(AValue.TypeInfo);
Result.Addr := AValue.GetReferenceToRawData;
end;
function TLocation.GetValue: TValue;
begin
TValue.Make(Addr, Typ.Handle, Result);
end;
procedure TLocation.Index(n: Integer);
var
sa: TRttiArrayType;
da: TRttiDynamicArrayType;
begin
if Typ is TRttiArrayType then
begin
// extending this to work with multi-dimensional arrays and non-zero
// based arrays is left as an exercise for the reader ... :)
sa := TRttiArrayType(Typ);
Addr := PByte(Addr) + sa.ElementType.TypeSize * n;
Typ := sa.ElementType;
end
else if Typ is TRttiDynamicArrayType then
begin
da := TRttiDynamicArrayType(Typ);
Addr := PPByte(Addr)^ + da.ElementType.TypeSize * n;
Typ := da.ElementType;
end
else
raise Exception.CreateFmt('[] applied to non-array type %s', [Typ.Name]);
end;
procedure TLocation.SetValue(const AValue: TValue);
begin
AValue.Cast(Typ.Handle).ExtractRawData(Addr);
end;
This type can be used to navigate locations within values using RTTI. To make it slightly easier to use, and slightly more fun for me to write, I also wrote a parser - the Follow method:
function GetPathLocation(const APath: string; ARoot: TLocation): TLocation;
{ Lexer }
function SkipWhite(p: PChar): PChar;
begin
while IsWhiteSpace(p^) do
Inc(p);
Result := p;
end;
function ScanName(p: PChar; out s: string): PChar;
begin
Result := p;
while IsLetterOrDigit(Result^) do
Inc(Result);
SetString(s, p, Result - p);
end;
function ScanNumber(p: PChar; out n: Integer): PChar;
var
v: Integer;
begin
v := 0;
while (p >= '0') and (p <= '9') do
begin
v := v * 10 + Ord(p^) - Ord('0');
Inc(p);
end;
n := v;
Result := p;
end;
const
tkEof = #0;
tkNumber = #1;
tkName = #2;
tkDot = '.';
tkLBracket = '[';
tkRBracket = ']';
var
cp: PChar;
currToken: Char;
nameToken: string;
numToken: Integer;
function NextToken: Char;
function SetToken(p: PChar): PChar;
begin
currToken := p^;
Result := p + 1;
end;
var
p: PChar;
begin
p := cp;
p := SkipWhite(p);
if p^ = #0 then
begin
cp := p;
currToken := tkEof;
Exit(currToken);
end;
case p^ of
'0'..'9':
begin
cp := ScanNumber(p, numToken);
currToken := tkNumber;
end;
'^', '[', ']', '.': cp := SetToken(p);
else
cp := ScanName(p, nameToken);
if nameToken = '' then
raise Exception.Create('Invalid path - expected a name');
currToken := tkName;
end;
Result := currToken;
end;
function Describe(tok: Char): string;
begin
case tok of
tkEof: Result := 'end of string';
tkNumber: Result := 'number';
tkName: Result := 'name';
else
Result := '''' + tok + '''';
end;
end;
procedure Expect(tok: Char);
begin
if tok <> currToken then
raise Exception.CreateFmt('Expected %s but got %s',
[Describe(tok), Describe(currToken)]);
end;
{ Semantic actions are methods on TLocation }
var
loc: TLocation;
{ Driver and parser }
begin
cp := PChar(APath);
NextToken;
loc := ARoot;
// Syntax:
// path ::= ( '.' <name> | '[' <num> ']' | '^' )+ ;;
// Semantics:
// '<name>' are field names, '[]' is array indexing, '^' is pointer
// indirection.
// Parser continuously calculates the address of the value in question,
// starting from the root.
// When we see a name, we look that up as a field on the current type,
// then add its offset to our current location if the current location is
// a value type, or indirect (PPointer(x)^) the current location before
// adding the offset if the current location is a reference type. If not
// a record or class type, then it's an error.
// When we see an indexing, we expect the current location to be an array
// and we update the location to the address of the element inside the array.
// All dimensions are flattened (multiplied out) and zero-based.
// When we see indirection, we expect the current location to be a pointer,
// and dereference it.
while True do
begin
case currToken of
tkEof: Break;
'.':
begin
NextToken;
Expect(tkName);
loc.FieldRef(nameToken);
NextToken;
end;
'[':
begin
NextToken;
Expect(tkNumber);
loc.Index(numToken);
NextToken;
Expect(']');
NextToken;
end;
'^':
begin
loc.Dereference;
NextToken;
end;
else
raise Exception.Create('Invalid path syntax: expected ".", "[" or "^"');
end;
end;
Result := loc;
end;
Here's an example type, and a routine (P) that manipulates it:
type
TPoint = record
X, Y: Integer;
end;
TArr = array[0..9] of TPoint;
TFoo = class
private
FArr: TArr;
constructor Create;
function ToString: string; override;
end;
{ TFoo }
constructor TFoo.Create;
var
i: Integer;
begin
for i := Low(FArr) to High(FArr) do
begin
FArr[i].X := i;
FArr[i].Y := -i;
end;
end;
function TFoo.ToString: string;
var
i: Integer;
begin
Result := '';
for i := Low(FArr) to High(FArr) do
Result := Result + Format('(%d, %d) ', [FArr[i].X, FArr[i].Y]);
end;
procedure P;
var
obj: TFoo;
loc: TLocation;
ctx: TRttiContext;
begin
obj := TFoo.Create;
Writeln(obj.ToString);
ctx := TRttiContext.Create;
loc := TLocation.FromValue(ctx, obj);
Writeln(loc.Follow('.FArr[2].X').GetValue.ToString);
Writeln(obj.FArr[2].X);
loc.Follow('.FArr[2].X').SetValue(42);
Writeln(obj.FArr[2].X); // observe value changed
// alternate syntax, not using path parser, but location destructive updates
loc.FieldRef('FArr');
loc.Index(2);
loc.FieldRef('X');
loc.SetValue(24);
Writeln(obj.FArr[2].X); // observe value changed again
Writeln(obj.ToString);
end;
The principle can be extended to other types and Delphi expression syntax, or TLocation may be changed to return new TLocation instances rather than destructive self-updates, or non-flat array indexing may be supported, etc.