Finally i found easy solution for my issue.
Finally i found easy solution for my issue.
Originally shared by Alexey Petushkov
Automating cloning plain-old-data objects.
Working with records in Delphi has a nice feature - all reference counting for fields (strings, interfaces, dyn arrays) are performed automatically.
But there is no same goodies for objects!
Good news - i have made an example using low level RTTI which adds Clone method to POD class which allows to copy its content "record-style".
It is compatible with Delphi 2010 up to XE4.
Download it here
http://owlyci.com/package/jojoba/testTypInfo/0.0.1
http://owlyci.com/package/jojoba/testTypInfo/0.0.1
Originally shared by Alexey Petushkov
Automating cloning plain-old-data objects.
Working with records in Delphi has a nice feature - all reference counting for fields (strings, interfaces, dyn arrays) are performed automatically.
But there is no same goodies for objects!
Good news - i have made an example using low level RTTI which adds Clone method to POD class which allows to copy its content "record-style".
It is compatible with Delphi 2010 up to XE4.
Download it here
http://owlyci.com/package/jojoba/testTypInfo/0.0.1
http://owlyci.com/package/jojoba/testTypInfo/0.0.1
thanks, could be usefull, although I use records when possible (much faster)
ReplyDeleteRecords are great, but this solution has same speed as records, except time for memory allocation
ReplyDeleteThe Move(pointer(Self)^, pointer(TObject(Result))^, InstanceSize); is wrong as it also does a flat copy of the ref counted fields aswell which results in messed up refcounts when doing the _CopyRecord. You can test then when you free the copy and turn memleak detection on. It will not report the memleak for your train field as it got released already. Same goes for an interface field.
ReplyDeleteModified it a bit and saw a strange result. Added a protected field.
ReplyDeleteModified two variables.
...
TTrain902Model = class( TBaseModel )
protected
extra: String;
public
train: String;
time: TDateTime;
carsCount: Integer;
dbStation: Integer;
tid: Integer;
class function getCollectionName: string; override;
end;
...
procedure Dump(const Name:String; var m: TTrain902Model);
begin
Writeln(Format('%s %s, %s, %d, %s, %d, %d', [Name, m.extra, m.Train, m.CarsCount, FormatDateTime('h:m:s', m.time), m.dbStation, m.tid]));
end;
var
m, m2: TTrain902Model;
begin
m := TTrain902Model.Create;
m.Train := 'AAABBB';
m.extra := 'EX';
m.CarsCount := 10;
m.time := Now;
m.dbStation := 100500;
m.tid := 1;
m2 := m.Clone;
m2.train := 'BBBCCC';
m2.extra := 'TRA';
Dump('m ', m);
Dump('m2', m2);
Writeln('Done, press any key');
Readln;
end.
Output:
m 50, 16:3:50, 10, 16:3:50, 100500, 1
m2 TRA, BBBCCC, 10, 16:3:50, 100500, 1
Done, press any key
Where did 'EX' go for output m?
Btw you can access the _CopyRecord routine directly which should be faster than the extra trip to CopyArray for one element:
ReplyDeleteprocedure CopyRecord(Dest, Source, TypeInfo: Pointer);
asm
jmp System.@CopyRecord
end;
Just checked both issues - it is managing interface counting and protected members is no problem. Also i have enabled memory leaks reporting, so check it
ReplyDeletehttp://t.owlyci.com/package/jojoba/testTypInfo/0.0.2
Lars Fosdal Oh, just i see issue with strings. Searching for solution ...
ReplyDeleteStefan Glienke
ReplyDeleteIs it compatible with x64?
Alexey Petushkov Add logging before the 2 FreeAndNil calls and you will see that your interfaced object gets destroyed prematurely (same most likely is the case for Lars' issue). The Move is not necessary because that is what CopyRecord does anyway (just with handling the managed references correctly. Otherwise the CopyIntf will mess up the RefCount
ReplyDeleteAnd yes, it should be compatible.
P.S. Yes, the Move is the cause for the string issue Lars mentioned.
Stefan Glienke Yep, it is looking like its freed after first destructor. Searching for solution ...
ReplyDeleteI told you the solution: only use Move when the InitTable is nil
ReplyDeleteStefan Glienke You are right :)
ReplyDeleteNice solution!
ReplyDeleteVery fast routine but it doesn't clone enumeration types.
ReplyDeleteAnother potential issue: Side effects in property setters won't happen.
ReplyDeleteLars Fosdal It is suitable for simple POD objects/classes. For more complicated cases need inherit TPersistent and use Assign.
ReplyDeleteLinas Naginionis Did you use Move when InitTable is nil, like Stefan recommended? It should work. Can you give example of issued class?
Alexey Petushkov Just define some enumeration type, e.g. TModelType = (mtSimple, mtAdvanced); and add it into your model:
ReplyDeleteTTrain902Model = class(TBaseModel)
...
mtype: TModelType;
Then set it to mtAdvanced before cloning the object and you'll see that after cloning mtype default field value hasn't changed.
Linas Naginionis Sorry, can test this only on my work after 2nd September (i'm on a vacation now).
ReplyDeleteI see the problem. Using the InitTable goes only up to the last managed field. So if you add any fields after that they wont get copied by it (need Move)
ReplyDeleteStefan Glienke - How do you mean "last managed field"? Are there other types affected as well?
ReplyDeleteThat InitTable looks like a compiler generated typeinfo that covers all fields up to the last managed one. Have to dig through source and take a look at my Delphi in a nutshell to get more infos. My guess atm is that you have to get the size of that compiler generated record info and maybe call move on any fields that follow as they are not handled by the CopyRecord call in that case.
ReplyDeleteSo this is what I came up with so far (for GetInlineSize check Rtti.pas - I just copied it)
ReplyDeleteprocedure CopyObject(Source: TObject; var Dest: TObject);
var
ClassPtr: TClass;
InitTable: PTypeInfo;
TypeData: PTypeData;
SourcePtr, DestPtr: Pointer;
Size: Integer;
ManagedField: PManagedField;
begin
SourcePtr := Source;
DestPtr := TObject(Dest);
Size := 0;
ClassPtr := Source.ClassType;
InitTable := PPointer(PByte(ClassPtr) + vmtInitTable)^;
if InitTable <> nil then
begin
// Copy ref-counted values
CopyRecord(DestPtr, SourcePtr, InitTable);
// Determine remaining memory size to be copied
TypeData := GetTypeData(InitTable);
ManagedField := Pointer(PByte(TypeData) + SizeOf(Integer) * 2);
Inc(ManagedField, TypeData.ManagedFldCount - 1);
Size := ManagedField.FldOffset + Abs(GetInlineSize(ManagedField.TypeRef^));
if Size < Source.InstanceSize then
begin
SourcePtr := PByte(SourcePtr) + Size;
DestPtr := PByte(DestPtr) + Size;
end;
end;
Move(SourcePtr^, DestPtr^, Source.InstanceSize - Size - hfFieldSize); // do not copy the hidden MonitorField
end;
Stefan Glienke It looks like your version works perfectly well. Will test it more later.
ReplyDeleteStefan Glienke Why doesn't MonitorField get copied?
ReplyDeleteNicholas Ring Because that hidden field is used for the TMonitor locking on instance. When we want to clone an object we don't want to copy any possible lock.
ReplyDeleteIt would also break it because if the lock is released on the original instance the copy still has the reference to the already freed TMonitor instance (dangling pointer) and then it would crash in TObject.CleanupInstance since there the TMonitor instance is getting freed.
You can test that by wrapping the clone call in Monitor-Enter(m)/MonitorExit(m) and remove the - hfFieldSize from the CopyObject routine. Then watch the application crash on the FreeAndNil(m2)
btw: we should also take care of TInterfacedObject because in that case we definetly don't want to copy the refCount.
Stefan Glienke thanks for the explanation
ReplyDelete