On Wed, 31 Jan 2024, Amir--- via fpc-pascal wrote:
Without more info (declaration of ChildTClass, declaration of the
constructor
of that class etc), it is not possible to comment.
We need a complete compilable code sample to provide you with more insight.
Please have a look at the attachment.
The constructor of TObject is not virtual, in difference with the destructor.
Given the definitions
ChildObj: TObject;
ChildTClass: TClass;
The following statement
ChildObj := ChildTClass.Create;
will always use the TObject.Create, since it is not virtual.
In general, you cannot use TObject for this kind of thing.
For this to work, you need to create a descendent of TObject with a virtual
constructor (call it TMyObject) of known signature, and do
ChildObj: TMyObject;
ChildTClass: TMyClass; // class of TMyobject
then
ChildObj := ChildTClass.Create;
will take the correct overridden constructor.
Your code is also incomplete in the sense that it will only work for classes
with a constructor without arguments.
If a overloaded constructor exists which takes arguments (like TComponent),
it will not be called and the class will not be instantiated correctly.
But maybe that will not be your use-case.
I attached a version of your program that works and has no memleaks.
Michael.program FieldAddress;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, TypInfo
{ you can add units after this };
type
{$M+}
{ TValue }
TMyObject = class (TObject)
constructor create; virtual;
end;
TMyClass = class of TMyObject;
TValue = class(TMyObject)
private
FV: PInteger;
public
constructor Create; override;
destructor destroy; override;
end;
{ TParam }
TParam = class(TObject)
public
destructor destroy; override;
published
V1: TValue;
V2: TValue;
end;
procedure Process(vft: PVmtFieldTable; Obj: TObject);
var
vfe: PVmtFieldEntry;
i: SizeInt;
Name: AnsiString;
ChildObj: TMyObject;
ChildTClass: TMyClass;
FieldClass : TClass;
begin
if vft=nil then exit;
Writeln(vft^.Count, ' field(s) with ', vft^.ClassTab^.Count, ' type(s)');
for i := 0 to vft^.Count - 1 do
begin
vfe := vft^.Field[i];
Name := vfe^.Name;
Writeln(i, ' -> ', vfe^.Name, ' @ ', vfe^.FieldOffset, ' of type ',
vft^.ClassTab^.ClassRef[vfe^.TypeIndex - 1]^.ClassName);
FieldClass := vft^.ClassTab^.ClassRef[vfe^.TypeIndex - 1]^;
if FieldClass.InheritsFrom(TMyObject) then
begin
Writeln('Inherits');
ChildTClass := TMyClass(FieldClass);
WriteLn('ChidTClass: ', ChildTClass.ClassName);
ChildObj := ChildTClass.Create;
if ((ChildObj as TValue).FV = nil) or ((ChildObj as TValue).FV^ <> 1)
then
begin
WriteLn('ERROR');
Halt(1);
end;
writeln('Calling sub');
TObject(Obj.FieldAddress(Name)^):=ChildObj;
Process(
PVmtFieldTable(PVMT(ChildTClass)^.vFieldTable),
ChildObj
);
end;
end;
end;
{ TValue }
constructor TMyObject.create;
begin
end;
constructor TValue.Create;
begin
inherited Create;
Writeln('Called');
FV := New(PInteger);
FV^ := 1;
end;
destructor TValue.Destroy;
begin
dispose(FV);
inherited;
end;
{ TParam}
destructor TParam.Destroy;
begin
V1.Free;
V2.Free;
Inherited;
end;
var
Param: TParam;
begin
Param := TParam.Create;
Process(PVmtFieldTable(PVMT(TParam)^.vFieldTable), Param);
Param.Free;
end.
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
