How to use a list of records - delphi

I have a record in a method as a local variable. Then I add it to a TList that is a member of the class. Now my question is after the method is finished, is the record is still valid? (or its destroyed and I shouldn't use MyList.List[0]).
this is a sample code:
TTestClass = class
MyList: TList<TMyRec>;
procedure add;
end;
procedure TTestClass.add;
var
ARec: TMyRec;
begin
Arec.a:= 100;
ARec.b:= 'abc';
MyList.add(ARec);
end;

is the record is still valid?
No, but its value is.
Records are value types allocated on the stack, which means they are passed by value (copied on each assignment)
When you use them as you did, you are actually preforming an implicit copy from your local variable to the storage in the list.
So no, the record declared in the var block is not valid when the method finishes execution. But its value is already copied to the storage of the list and therefore it is a valid value.
Consider the following code for more illustration:
program Project20;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, system.generics.collections;
type
PMyRec = ^TMyRec;
TMyRec = record
a: Integer;
b: string;
end;
TTestClass = class
MyListOfPointers: TList<PMyRec>;
MyListOfValues: TList<TMyRec>;
constructor Create;
destructor Destroy; override;
procedure add;
procedure addP;
procedure ShowRecs;
end;
procedure TTestClass.add;
var
ARec: TMyRec;
begin
Arec.a:= 100;
ARec.b:= 'abc';
MyListOfValues.add(ARec);
end;
procedure TTestClass.addP;
var
ARec: TMyRec;
begin
Arec.a:= 100;
ARec.b:= 'abc';
MyListOfPointers.add(#ARec);
end;
constructor TTestClass.Create;
begin
MyListOfPointers := TList<PMyRec>.Create;
MyListOfValues := TList<TMyRec>.Create;
end;
destructor TTestClass.Destroy;
begin
MyListOfPointers.Free;
MyListOfValues.Free;
inherited;
end;
procedure TTestClass.ShowRecs;
begin
writeln(PMyRec(MyListOfPointers[0])^.b + ' ' + PMyRec(MyListOfPointers[0])^.a.ToString);
writeln(MyListOfValues[0].b + ' ' + MyListOfValues[0].a.ToString);
end;
var
MyClass: TTestClass;
begin
try
MyClass := TTestClass.Create;
try
MyClass.Add;
MyClass.AddP;
MyClass.ShowRecs;
finally
MyClass.Free;
end;
Readln;
except
on E: Exception do
begin
Writeln(E.ClassName, ': ', E.Message);
Readln;
end;
end;
end.
the output is
First attempt
39866256
abc 100
Second attempt
40390544
abc 100
You won't get an access violation but rather a unique behavior a will take any value on that address and b will always be empty (b = '') because it is a managed type.

Related

How do I use a string in TRttiMethod.Invoke as parameter properly?

I'm trying to generalize the content validation of visual components with the Text-property using RTTI but when I try to pass a string value into TRttiMethod.Invoke, I get the Message "Invalid Typecast". (Actually "Ungültige Typumwandlung" but I guess, that was a fitting translation.)
The code below is stripped of all security measures, assertions and so on, assuming all passed objects are just perfect.
procedure ValidateTextFieldAndSetFocus(const Field: TObject; const Validator: TObject; const errorStates: array of TStringValidationResult; const sErrorMessage: string);
var
context : TRttiContext;
objField : TRttiType;
objValid : TRttiType;
prop : TRttiProperty;
execute : TRttiMethod;
I : Integer;
validResult : TStringValidationResult;
value : TValue;
begin
context := TRttiContext.Create;
objField := context.GetType(Field.ClassInfo);
objValid := context.GetType(Validator.ClassInfo);
prop := objField.GetProperty('Text');
value := prop.GetValue(Field);
execute := objValid.GetMethod('Execute');
for I := 0 to High(errorStates) do
if execute.Invoke(Validator,[value]).TryAsType<TStringValidationResult>(validResult) then
if validResult = errorStates[I] then
begin
SetFocusIfCan(Field);
raise Exception.Create(sErrorMessage);
end;
end;
The Validator's Execute only has one string-Parameter. I've seen examples where strings were passed directly into the array of TValue, but then I get the same typecast error.
edit:
The actual error appears in execute.Invoke(Validator,[value]).
Example
TNoSemicolonNullValidator = class
class function Execute(const aStr: string): TStringValidationResult;
end;
procedure TestValidation;
var
Validator : TNoSemicolonNullValidator;
begin
Validator := TNoSemicolonNullValidator.Create;
try
ValidateTextFieldAndSetFocus(Edit1,Validator,[svInvalid],'Edit1 is invalid!');
finally
Validator.Free;
end;
end;
You are calling a class function here but you are passing a TObject as first parameter (which is the hidden Self argument of non static methods). On a class method the Self parameter must not be an instance but the class of it. So the correct call would be:
execute.Invoke(validator.ClassType, [value]);
Here is a minimal example to prove that:
program Project1;
{$APPTYPE CONSOLE}
uses
Rtti,
SysUtils;
type
TValidator = class
class function Execute(const s: string): Boolean;
end;
class function TValidator.Execute(const s: string): Boolean;
begin
Writeln(s);
end;
var
ctx: TRttiContext;
v: TValidator;
begin
v := TValidator.Create;
try
ctx.GetType(TValidator).GetMethod('Execute').Invoke(v, ['test']);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
try
ctx.GetType(TValidator).GetMethod('Execute').Invoke(v.ClassType, ['test']);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.

In Delphi XE3, how can I cast a TVirtualInterface object to its interface, using TypeInfo or RTTI?

I'm trying to use TVirtualInterface. I've mostly tried to follow the examples at the Embarcadero doc wiki and at Nick Hodges' blog.
However, What I'm trying to do is a little bit different from the standard examples.
I have simplified the following sample code as much as I can to illustrate what I am trying to do. I have left out obvious validation and error handling code.
program VirtualInterfaceTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Generics.Collections,
System.Rtti,
System.SysUtils,
System.TypInfo;
type
ITestData = interface(IInvokable)
['{6042BB6F-F30C-4C07-8D3B-C123CF1FF60F}']
function GetComment: string;
procedure SetComment(const Value: string);
property Comment: string read GetComment write SetComment;
end;
IMoreData = interface(IInvokable)
['{1D2262CE-09F4-45EC-ACD8-3EEE6B2F1548}']
function GetSuccess: Boolean;
procedure SetSuccess(const Value: Boolean);
property Success: Boolean read GetSuccess write SetSuccess;
end;
TDataHolder = class
private
FTestData: ITestData;
FMoreData: IMoreData;
public
property TestData: ITestData read FTestData write FTestData;
property MoreData: IMoreData read FMoreData write FMoreData;
end;
TVirtualData = class(TVirtualInterface)
private
FData: TDictionary<string, TValue>;
procedure DoInvoke(Method: TRttiMethod;
const Args: TArray<TValue>;
out Result: TValue);
public
constructor Create(PIID: PTypeInfo);
destructor Destroy; override;
end;
constructor TVirtualData.Create(PIID: PTypeInfo);
begin
inherited Create(PIID, DoInvoke);
FData := TDictionary<string, TValue>.Create;
end;
destructor TVirtualData.Destroy;
begin
FData.Free;
inherited Destroy;
end;
procedure TVirtualData.DoInvoke(Method: TRttiMethod;
const Args: TArray<TValue>;
out Result: TValue);
var
key: string;
begin
if (Pos('Get', Method.Name) = 1) then
begin
key := Copy(Method.Name, 4, MaxInt);
FData.TryGetValue(key, Result);
end;
if (Pos('Set', Method.Name) = 1) then
begin
key := Copy(Method.Name, 4, MaxInt);
FData.AddOrSetValue(key, Args[1]);
end;
end;
procedure InstantiateData(obj: TObject);
var
rttiContext: TRttiContext;
rttiType: TRttiType;
rttiProperty: TRttiProperty;
propertyType: PTypeInfo;
data: IInterface;
value: TValue;
begin
rttiContext := TRttiContext.Create;
try
rttiType := rttiContext.GetType(obj.ClassType);
for rttiProperty in rttiType.GetProperties do
begin
propertyType := rttiProperty.PropertyType.Handle;
data := TVirtualData.Create(propertyType) as IInterface;
value := TValue.From<IInterface>(data);
// TValueData(value).FTypeInfo := propertyType;
rttiProperty.SetValue(obj, value); // <<==== EInvalidCast
end;
finally
rttiContext.Free;
end;
end;
procedure Test_UsingDirectInstantiation;
var
dataHolder: TDataHolder;
begin
dataHolder := TDataHolder.Create;
try
dataHolder.TestData := TVirtualData.Create(TypeInfo(ITestData)) as ITestData;
dataHolder.MoreData := TVirtualData.Create(TypeInfo(IMoreData)) as IMoreData;
dataHolder.TestData.Comment := 'Hello World!';
dataHolder.MoreData.Success := True;
Writeln('Comment: ', dataHolder.TestData.Comment);
Writeln('Success: ', dataHolder.MoreData.Success);
finally
dataHolder.Free;
end;
end;
procedure Test_UsingIndirectInstantiation;
var
dataHolder: TDataHolder;
begin
dataHolder := TDataHolder.Create;
try
InstantiateData(dataHolder); // <<====
dataHolder.TestData.Comment := 'Hello World!';
dataHolder.MoreData.Success := False;
Writeln('Comment: ', dataHolder.TestData.Comment);
Writeln('Success: ', dataHolder.MoreData.Success);
finally
dataHolder.Free;
end;
end;
begin
try
Test_UsingDirectInstantiation;
Test_UsingIndirectInstantiation;
except on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
I have some arbitrary interfaces with read/write properties, ITestData and IMoreData, and a class that holds references to these interfaces, IDataHolder.
I have created a class, TVirtualData, that inherits from TVirtualInterface, following Nick Hodges' examples. And when I use this class the way I see it in all the examples, as in Test_UsingDirectInstantiation, it works swell.
What my code needs to do, however, is instantiate the interfaces in a more indirect manner, as in Test_UsingIndirectInstantiation.
The InstantiateData method uses RTTI, and works well up until the SetValue call which throws an EInvalidCast exception ("Invalid class typecast").
I added in the commented line (which I saw in some sample code from "Delphi Sorcery") to try to cast the data object to the appropriate interface. This allowed the SetValue call to run cleanly, but when I tried to access the interface property (i.e. dataHolder.TestData.Comment) it threw a EAccessViolation exception ("Access violation at address 00000000. Read of address 00000000").
For fun I replace IInterface in the InstantiateData method with ITestData, and for the first property it worked fine, but naturally, it didn't work for the second property.
Question: Is there a way to dynamically cast this TVirtualInterface object to the appropriate interface using TypeInfo or RTTI (or something else) so that the InstantiateData method has the same effect as setting the properties directly?
First you have to cast the instance to the correct interface and not IInterface. You can still store it in an IInterface variable though but it really containes the reference to the correct interface type.
Then you have to put that into a TValue with the correct type and not IInterface (RTTI is very strict about types)
The commented line you added was just to work around the second but as it was really containing the IInterface reference (and not a ITestData or TMoreData references) it resulted on the AV.
procedure InstantiateData(obj: TObject);
var
rttiContext: TRttiContext;
rttiType: TRttiType;
rttiProperty: TRttiProperty;
propertyType: PTypeInfo;
data: IInterface;
value: TValue;
begin
rttiType := rttiContext.GetType(obj.ClassType);
for rttiProperty in rttiType.GetProperties do
begin
propertyType := rttiProperty.PropertyType.Handle;
Supports(TVirtualData.Create(propertyType), TRttiInterfaceType(rttiProperty.PropertyType).GUID, data);
TValue.Make(#data, rttiProperty.PropertyType.Handle, value);
rttiProperty.SetValue(obj, value);
end;
end;

How to clear pointer in stringlist?

I do not understand where are the objects below and how to clear them?
for example:
public
Alist: TStringlist;
..
procedure TForm1.FormCreate(Sender: TObject);
begin
Alist:=Tstringlist.Create;
end;
procedure TForm1. addinstringlist;
var
i: integer;
begin
for i:=0 to 100000 do
begin
Alist.add(inttostr(i), pointer(i));
end;
end;
procedure TForm1.clearlist;
begin
Alist.clear;
// inttostr(i) are cleared, right?
// Where are pointer(i)? Are they also cleared ?
// if they are not cleared, how to clear ?
end;
procedure TForm1. repeat; //newly added
var
i: integer;
begin
For i:=0 to 10000 do
begin
addinstringlist;
clearlist;
end;
end; // No problem?
I use Delphi 7. In delphi 7.0 help file, it says:
AddObject method (TStringList)
Description
Call AddObject to add a string and its associated object to the list.
AddObject returns the index of the new string and object.
Note:
The TStringList object does not own the objects you add this way.
Objects added to the TStringList object still exist
even if the TStringList instance is destroyed.
They must be explicitly destroyed by the application.
In my procedure Alist.add(inttostr(i), pointer(i)), I did not CREATE any object. Were there objects or not ?
how can I clear both inttostr(i) and pointer(i).
Thank you in advance
There is no need to clear Pointer(I) because the pointer does not reference any object. It is an Integer stored as Pointer.
Advice: if you are not sure does your code leak or not write a simple test and use
ReportMemoryLeaksOnShutDown:= True;
If your code leaks you will get a report on closing the test application.
No the code you added does not leak. If your want to check it write a test like this:
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
var
List: TStringlist;
procedure addinstringlist;
var
i: integer;
begin
for i:=0 to 100 do
begin
List.addObject(inttostr(i), pointer(i));
end;
end;
procedure clearlist;
begin
List.clear;
end;
procedure repeatlist;
var
i: integer;
begin
For i:=0 to 100 do
begin
addinstringlist;
clearlist;
end;
end;
begin
ReportMemoryLeaksOnShutDown:= True;
try
List:=TStringList.Create;
repeatlist;
List.Free;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Try to comment List.Free line to create a memory leak and see what happens.

How to identify the Object type?

Lets say I have a Treeview, and it contains items with Object pointers. How can I determine from the selected item what the Object is, so I can access it?
Here is a basic example of some classes and code to give an idea:
Note: TChildObject1 and TChildObject2 inherit from TMyObject.
type
TMyObject = class
private
FName: string;
public
property Name: string read FName write FName;
constructor Create(aName: string);
end;
type
TChildObject1 = class(TMyObject)
private
FSomeString: string;
public
property SomeString: string read FSomeString write FSomeString;
constructor Create(aName: string);
destructor Destroy; override;
end;
type
TChildObject2 = class(TMyObject)
private
FSomeInteger: integer;
public
property SomeInteger: integer read FSomeInteger write FSomeInteger;
constructor Create(aName: string);
destructor Destroy; override;
end;
Lets say they were created and added to a TTreeview like so:
procedure NewChild1(aTreeView: TTreeView; aName: string);
var
Obj: TChildObject1;
begin
Obj := TChildObject1.Create(aName);
try
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
finally
Obj.Free;
end;
end;
procedure NewChild2(aTreeView: TTreeView; aName: string);
var
Obj: TChildObject2;
begin
Obj := TChildObject2.Create(aName);
try
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
finally
Obj.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// add the items to the tree
NewChild1(TreeView1, 'Child Object 1');
NewChild2(TreeView1, 'Child Object 2');
end;
Now, when I select a Node in the Treeview, how can I determine which Object class the pointer leads to? I tried this, which is not working:
Note: This does not error, but it does not return the correct value (ie, does not pick up the correct object)
procedure TForm1.TreeView1Click(Sender: TObject);
var
Obj: TMyObject;
begin
if TreeView1.Selected <> nil then
begin
Obj := TMyObject(TreeView1.Selected.Data);
if Obj is TChildObject1 then
begin
Edit1.Text := 'this node is a child1 object';
end else
if Obj is TChildObject2 then
begin
Edit1.Text := 'and this node is child 2 object';
end;
end;
end;
I could do it something like below, but I don't think is the right way, it means a lot of checking, declaring, assigning etc.
procedure TForm1.TreeView1Click(Sender: TObject);
var
ChildObj1: TChildObject1;
ChildObj2: TChildObject2;
begin
if TreeView1.Selected <> nil then
begin
if TreeView1.Selected.Text = 'Child Object 1' then
begin
ChildObj1 := TreeView1.Selected.Data;
Edit1.Text := ChildObj1.SomeString;
end else
if TreeView1.Selected.Text = 'Child Object 2' then
begin
ChildObj2 := TreeView1.Selected.Data;
Edit1.Text := IntToStr(ChildObj2.SomeInteger);
end;
end;
end;
Tips and advice appreciated.
The main problem is which you are freeing the memory of the object that you are adding to the treeview. So the data of the nodes points to a invalid location.
To assign the objects to a node use a code like this
Obj := TChildObject1.Create(aName);
aTreeView.Items.AddObject(nil, Obj.Name, Obj);
and when you need dispose the data you can call the Free method for each node.
for i:= 0 to TreeView1.Items.Count - 1 do
begin
Obj:= TMyObject(TreeView1.Items.Item[i].Data);
if Assigned(Obj) then
Obj.Free;
end;

Delphi: invoke constructor raises EInvalidCast

I'm trying to invoke a constructor obtained via RTTI (running D2010 version 14.0.3593.25826). The constructor takes a mixture of strings and objects as its arguments, all of which should be initialized to '' or nil. (Disclaimer: I know that the desired constructor will be the one with maximum number of parameters, hence the weird-looking, although suboptimal design.)
The code goes as follows:
program sb_rtti;
{$APPTYPE CONSOLE}
uses RTTI, TypInfo, SysUtils;
type
TMyClass = class (TObject)
FField1: string;
FObject1: TObject;
public
constructor Create(Field1: string = ''; Object1: TObject = nil);
end;
constructor TMyClass.Create(Field1: string; Object1: TObject);
begin
FField1 := Field1;
FObject1 := Object1;
end;
function GetConstructor(rType: TRttiType) : TRttiMethod;
var
MaxParams: integer;
Methods: TArray<TRttiMethod>;
Method: TRttiMethod;
Params: TArray<TRttiParameter>;
begin
Methods := rType.GetMethods('Create');
MaxParams := 0;
for Method in Methods do begin
Params := Method.GetParameters();
if (Length(Params) > MaxParams) then begin
Result := Method;
MaxParams := Length(Params);
end;
end;
end;
procedure InitializeParam(Param: TRttiParameter; ActualParam: TValue);
begin
if (Param.ParamType.TypeKind = TTypeKind.tkClass) then begin
ActualParam := TValue.From<TObject>(nil);
end else if (Param.ParamType.TypeKind = TTypeKind.tkString) then begin
ActualParam := TValue.From<string>('');
end else if (Param.ParamType.TypeKind = TTypeKind.tkUString) then begin
ActualParam := TValue.From<UnicodeString>('');
end else begin
// Other types goes here
end;
end;
var
Context: TRttiContext;
Constr: TRttiMethod;
Params: TArray<TRttiParameter>;
ResultValue: TValue;
rType: TRttiType;
ActualParams: array of TValue;
i: integer;
CurrentParam: TRttiParameter;
begin
Context := TRttiContext.Create();
rType := Context.GetType(TypeInfo(TMyClass));
Constr := GetConstructor(rType);
try
if (Constr <> nil) then begin
Params := Constr.GetParameters();
SetLength(ActualParams, Length(Params));
for i := 0 to Length(Params) - 1 do begin
CurrentParam := Params[i] as TRttiParameter;
InitializeParam(CurrentParam, ActualParams[i]);
end;
ResultValue := Constr.Invoke(rType.AsInstance.MetaclassType, ActualParams);
end;
except
on E : Exception do
WriteLn(E.ToString);
end;
ReadLn;
end.
Now, when the line ResultValue := Constr.Invoke(rType.AsInstance.MetaclassType, ActualParams); is executed, an EInvalidCast exception is raised. The exception may be traced to the TValue.Cast-method at line 1336.
However, the meat of the problem seems to be found at the previous point in the call stack, more precisely at line 4093 in rtti.pas (argList[currArg] := Args[i].Cast(parList[i].ParamType.Handle);).
My bet is that I'm using rtti in ways I'm not supposed to, yet, I can't find the "right way" described anywhere. Can anybody please point me in the right direction? Thanks!
You have a problem in the InitializeParam procedure because in the assignment of the ActualParam parameter, you are setting the value of the local copy of that parameter – remember that TValue (the type of ActualParam) is a record. So to fix the problem you must pass the ActualParam as a var parameter.
procedure InitializeParam(Param: TRttiParameter; var ActualParam: TValue);
It just occurred to me to hard-code the argument initialization by replacing
for i := 0 to Length(Params) - 1 do begin
CurrentParam := Params[i] as TRttiParameter;
InitializeParam(CurrentParam, ActualParams[i]);
end;
with
ActualParams[0] := TValue.From<string>('');
ActualParams[1] := TValue.From<TObject>(nil);
which solves the problem.

Resources